tuturto

(import [adderall.dsl [*]])
(require adderall.dsl)

(defreader t [expr] `(, ~@expr))

(defn secondᵒ [l x]
  (fresh [r]
    (restᵒ l r)
    (firstᵒ r x)))

tuturto

(import [adderall.dsl [*]])
(require adderall.dsl)

(defn lastᵒ [s l]
  (fresh [a]
    (appendᵒ a [l] s)))

(defn adjacentᵒ [x y z]
  (fresh [a b]
         (condᵉ

tuturto

(setv level-data 
  [[:wall-data
    [(, (, 5 5) :rock-wall)
     (, (, 6 5) :rock-wall)
     (, (, 7 5) :tile-wall)]]
   [:floor-data
    [(, (, 5 6) :dirt-floor)
     (, (, 6 6) :rock-floor)
     (, (, 7 6) :rock-floor)]]])

tuturto

;; -*- coding: utf-8 -*-
;;
;;   Copyright 2010-2014 Tuukka Turto
;;
;;   This file is part of pyherc.
;;
;;   pyherc 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.

tuturto

(require hy.contrib.anaphoric)
(require pyherc.macros)

(import [pyherc.data [new-level Portal add-portal get-locations-by-tag
                      wall-tile]]
        [pyherc.generators.level.partitioners.old-grid [RandomConnector]])

(defmacro run-generators [level &rest generators]
  (list (map (fn [x] `(ap-each ~x (it level))) generators)))

tuturto

;; Adapted from https://github.com/ReactiveX/RxPY/blob/master/examples/konamicode/konamicode.py

(import [rx.subjects [Subject]])

(setv codes [:up :up :down :down :left :right :left :right :b :a])
(setv subject (Subject))

(setv query (-> (.window_with_count subject 10 1)
                (.select-many (fn [win] (.sequence-equal win codes)))
                (.filter (fn [equal] equal))))

tuturto

(in-package #:cl-charms/low-level)

; #define COLOR_PAIR(n)      (((chtype)(n) << PDC_COLOR_SHIFT) & A_COLOR)

; for 32-bit curses
(defun COLOR-PAIR (n)
  (logand (ash n 24) #xff000000))

;(defun COLOR-PAIR (n)
;  (logand (ash n 24) (ash #x7fffffff 24)))

tuturto

(defmacro set-attributes [&rest attributes]
  `(do ~@(genexpr `(setattr self ~x ~x) [x attributes])))

(defmacro set-attributes [&rest attributes]
  `(do ~@(genexpr `(setv self.~x ~x) [x attributes])))
  
(defn --init-- [self foo bar baz]
  (set-attributes foo bar baz))
->
(defn --init-- [self foo bar baz]

tuturto

(defmacro set-parameters [&rest parameters]
  (defn setter [parameter]
    (HyExpression [(HySymbol "setv")
                   (HySymbol (+ "self." parameter))
                   (HySymbol parameter)]))
  `(do ~@(map setter parameters)))

(defclass Kissa []
  [[--init-- (fn [self name age]
               (super-init)

tuturto

;; do-trigger should be ~name, but there's two levels of quasi-quotes

(defmacro method-with-attributes [name]
  `(defmacro effect-trigger [attributes body]
     `[do-trigger (fn [self dying-rules]
                    (let [~@(genexpr `[~x (. self ~x)] [x attributes])]
                      ~body))]))