Skip to content

Instantly share code, notes, and snippets.

View muspellsson's full-sized avatar

Ivan Sukin muspellsson

7 followers · 15 following
View GitHub Profile
@muspellsson
muspellsson / math.r3
Created October 14, 2015 19:02
REBOL []
math: context [
eps: 1E-15
steps: 0
math-init: func [] [
steps: 0
]
@muspellsson
muspellsson / curses.r3
Last active October 12, 2015 17:51
REBOL []
switch fourth system/version [
3 [
curses: make library! %pdcurses.dll
kernel32: make library! %kernel32.dll
alloc-console: make routine! compose [
[
return: [int32]
@muspellsson
muspellsson / draw-ex.factor
Created February 27, 2015 08:00
! Copyright (C) 2015 Your name.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel ui.gadgets ui.render ui.gadgets.worlds opengl opengl.gl colors ;
IN: draw-ex
TUPLE: canv < gadget ;
: <canv> ( -- gadget ) canv new ;
M: canv draw-gadget* ( gadget -- )
@muspellsson
muspellsson / invar.tcl
Created November 10, 2014 10:01
proc invariant {var {expression ""} {msg "Illegal value"}} {
uplevel trace variable $var w \
\[list invariant_check \{$expression\} \{$msg\}]
}
proc invariant_check {expression msg v1 v2 mode} {
if {$expression == ""} {
error "Cannot modify!"
}
if {![uplevel expr \{$expression\}]} {
@muspellsson
muspellsson / define-c-constant.scm
Last active August 29, 2015 14:05
Wraps C constant value in Gambit Scheme FFI
(define-macro (define-c-constant name #!optional (type 'int) (new-name name))
`(define ,new-name
`,((c-lambda
() ,type
,(string-append "___result = " (symbol->string name) ";")))))
@muspellsson
muspellsson / mass-transfer.tcl
Last active December 22, 2015 00:08
# We need it for serious work
package require Tk 8.6
# We need it for fun
package require snack
package require snackogg
# Gas constant
set R 8.3144621
###########################################################################
@muspellsson
muspellsson / j-svg.ijs
Last active December 10, 2015 03:38
Simple example of loading SVG files with J language and bindings to Cairo and librsvg. It still needs more explanations.
NB. pretty stubby librsvg bindings
coclass 'jrsvg'
NB. define unnamed monad and call it in-place
NB. verb wrapping is needed for control structures
NB. as they work only within explicit definitions
monad define''
select. UNAME
case. 'Linux' do.
librsvg=:<'librsvg-2.so.2'
@muspellsson
muspellsson / de.scm
Created June 9, 2012 12:56
Modified Constraint Differential Evolution algorithm
;; Differential evolution minimization algorithm
;;
;; f -- minimized function
;; feasible? -- predicate for checking feasibility of a vector
;; initial-population
;; F -- value in v1 + F(v2 - v3). Must be in [0..2]
;; CR -- probability of crossing in crossover
;; generations -- maximal number of generations
(define (differential-evolution f feasible? initial-population F CR generations)
;; Auxiliary function breed
@muspellsson
muspellsson / identity.scm
Created June 9, 2012 11:05
Identity matrix generation in Scheme
(define (identity n)
(letrec
((uvec
(lambda (m i acc)
(if (= i n)
acc
(uvec m (+ i 1)
(cons (if (= i m) 1 0) acc)))))
(idgen
(lambda (i acc)
@muspellsson
muspellsson / beer.asm
Created February 15, 2011 20:06
99 bottles of beer in FASM bootsector
;=======================================================================
; an x86 bootsector implementation of
; 99 bottles of beer
; by Ivan Sukin <isukin.intelliware@gmail.com>
; based on template made by shoorick
;=======================================================================
;=======================================================================
; Drive info
;=======================================================================