used float2 and float to decrease LDS size

#pragma OPENCL EXTENSION cl_khr_3d_image_writes : enable
#pragma OPENCL EXTENSION cl_amd_printf : enable

__constant sampler_t sampler = CLK_NORMALIZED_COORDS_FALSE | CLK_ADDRESS_CLAMP | CLK_FILTER_NEAREST;

__kernel void GVFInit(__read_only image3d_t volume, __write_only image3d_t vector_field ) {
    // Calculate gradient using a 1D central difference for each dimension, with spacing 1
    int4 pos = {get_global_id(0), get_global_id(1), get_global_id(2), 0};

    float f100 = read_imagef(volume, sampler, pos + (int4)(1,0,0,0)).x;
    float f_100 = read_imagef(volume, sampler, pos - (int4)(1,0,0,0)).x;
    float f010 = read_imagef(volume, sampler, pos + (int4)(0,1,0,0)).x;
    float f0_10 = read_imagef(volume, sampler, pos - (int4)(0,1,0,0)).x;
    float f001 = read_imagef(volume, sampler, pos + (int4)(0,0,1,0)).x;
    float f00_1 = read_imagef(volume, sampler, pos - (int4)(0,0,1,0)).x;

    float4 gradient = {
        0.5f*(f100-f_100),
        0.5f*(f010-f0_10),
        0.5f*(f001-f00_1),
        0};

    gradient.w = gradient.x*gradient.x + gradient.y*gradient.y + gradient.z*gradient.z;

    write_imagef(vector_field, pos, gradient);
}

#define LA(x,y,z,w) (x + ((y & 1) << 3) + (w << 4) + ((y & 0x6) << 4) + (z << 7))
#define LA2(x,y,z) (x + (y<<3) + (z<<6))
__kernel __attribute__((reqd_work_group_size(8,8,4))) void GVFIteration(__read_only image3d_t init_vector_field, __read_only image3d_t read_vector_field, __write_only image3d_t write_vector_field, __private float mu) {

    int4 writePos = {
        get_global_id(0)-(get_group_id(0)*2+1),
        get_global_id(1)-(get_group_id(1)*2+1),
        get_global_id(2)-(get_group_id(2)*2+1),
        0
    };
    int3 localPos = {get_local_id(0), get_local_id(1), get_local_id(2)};

    // Enforce mirror boundary conditions
    //int4 size = {get_global_size(0), get_global_size(1), get_global_size(2), 0};
    //int4 pos = writePos;
    //pos = select(pos, (int4)(2,2,2,0), pos == (int4)(0,0,0,0));
    //pos = select(pos, size-3, pos == size-1);

    // Allocate shared memory
    __local float2 sharedMemory[8*4*8];
	__local float sharedMemorySingle[8*4*8];

    // Read into shared memory
    float4 v = read_imagef(read_vector_field, sampler, writePos);
    sharedMemory[LA2(localPos.x,localPos.y,localPos.z)] = v.xy;
    sharedMemorySingle[LA2(localPos.x,localPos.y,localPos.z)] = v.z;

    /*
    int x = localPos.x;
    int y = localPos.y;
    int z = localPos.z;
    int w = 0;
    int rowID2 = (LA2(x,y,z) >> 4) & 0x1F;
    int bankID2 = ((LA2(x,y,z)) & 0xF) << 1;
    int rowID = (LA2(x,y,z) >> 5) & 0x1F;
	int bankID = ((LA2(x,y,z)) & 0x1F);
    printf("Float2s: %d %d %d - %d - %d\n", x,y,z, bankID2, rowID2);
	printf("Floats: %d %d %d - %d - %d\n", x,y,z, bankID, rowID);
    */
    int3 comp = (localPos == (int3)(0,0,0)) +
        (localPos == (int3)(get_local_size(0)-1,get_local_size(1)-1,get_local_size(2)-1));

    // Synchronize the threads in the group
    barrier(CLK_LOCAL_MEM_FENCE);

    if(comp.x+comp.y+comp.z ==  0) {
    // Load data from shared memory and do calculations
    float4 init_vector = read_imagef(init_vector_field, sampler, writePos); // should read from pos

    float3 fx1;
    fx1.xy = sharedMemory[LA2(localPos.x+1,localPos.y,localPos.z)];
    fx1.z = sharedMemorySingle[LA2(localPos.x+1,localPos.y,localPos.z)];
    float3 fx_1;
    fx_1.xy = sharedMemory[LA2(localPos.x-1,localPos.y,localPos.z)];
    fx_1.z = sharedMemorySingle[LA2(localPos.x-1,localPos.y,localPos.z)];
    float3 fy1;
    fy1.xy = sharedMemory[LA2(localPos.x,localPos.y+1,localPos.z)];
    fy1.z = sharedMemorySingle[LA2(localPos.x,localPos.y+1,localPos.z)];
    float3 fy_1;
    fy_1.xy = sharedMemory[LA2(localPos.x,localPos.y-1,localPos.z)];
    fy_1.z = sharedMemorySingle[LA2(localPos.x,localPos.y-1,localPos.z)];
    float3 fz1;
    fz1.xy = sharedMemory[LA2(localPos.x,localPos.y,localPos.z+1)];
    fz1.z = sharedMemorySingle[LA2(localPos.x,localPos.y,localPos.z+1)];
    float3 fz_1;
    fz_1.xy = sharedMemory[LA2(localPos.x,localPos.y,localPos.z-1)];
    fz_1.z = sharedMemorySingle[LA2(localPos.x,localPos.y,localPos.z-1)];

    // Update the vector field: Calculate Laplacian using a 3D central difference scheme
    float3 laplacian = -6*v.xyz + fx1 + fx_1 + fy1 + fy_1 + fz1 + fz_1;

    v.xyz += mu * laplacian - (v.xyz - init_vector.xyz)*init_vector.w;

    write_imagef(write_vector_field, writePos, v);
    }
}

__kernel void GVFResult(__write_only image3d_t result, __read_only image3d_t vectorField) {

    int4 pos = {get_global_id(0), get_global_id(1), get_global_id(2), 0};
    float4 vector = read_imagef(vectorField, sampler, pos);
    vector.w = 0;
    //if(1 < length(vector))
    //    printf("%f %f %f\n", vector.x, vector.y, vector.z);
    write_imagef(result, pos, length(vector));
}

#pragma OPENCL EXTENSION cl_khr_3d_image_writes : enable
//#pragma OPENCL EXTENSION cl_amd_printf : enable

__constant sampler_t sampler = CLK_NORMALIZED_COORDS_FALSE | CLK_ADDRESS_CLAMP | CLK_FILTER_NEAREST;

__kernel void GVFInit(__read_only image3d_t volume, __write_only image3d_t vector_field ) {
    // Calculate gradient using a 1D central difference for each dimension, with spacing 1
    int4 pos = {get_global_id(0), get_global_id(1), get_global_id(2), 0};

    float f100 = read_imagef(volume, sampler, pos + (int4)(1,0,0,0)).x;
    float f_100 = read_imagef(volume, sampler, pos - (int4)(1,0,0,0)).x;
    float f010 = read_imagef(volume, sampler, pos + (int4)(0,1,0,0)).x;
    float f0_10 = read_imagef(volume, sampler, pos - (int4)(0,1,0,0)).x;
    float f001 = read_imagef(volume, sampler, pos + (int4)(0,0,1,0)).x;
    float f00_1 = read_imagef(volume, sampler, pos - (int4)(0,0,1,0)).x;

    float4 gradient = {
        0.5f*(f100-f_100),
        0.5f*(f010-f0_10),
        0.5f*(f001-f00_1),
        0};

    gradient.w = gradient.x*gradient.x + gradient.y*gradient.y + gradient.z*gradient.z;

    write_imagef(vector_field, pos, gradient);
}

#define LA(x,y,z,w) (x + ((y & 1) << 3) + (w << 4) + ((y & 0x6) << 4) + (z << 7))
__kernel __attribute__((reqd_work_group_size(8,8,4))) void GVFIteration(__read_only image3d_t init_vector_field, __read_only image3d_t read_vector_field, __write_only image3d_t write_vector_field, __private float mu) {

    int4 writePos = {
        get_global_id(0)-(get_group_id(0)*2+1),
        get_global_id(1)-(get_group_id(1)*2+1),
        get_global_id(2)-(get_group_id(2)*2+1),
        0
    };
    int3 localPos = {get_local_id(0), get_local_id(1), get_local_id(2)};

    // Enforce mirror boundary conditions
    //int4 size = {get_global_size(0), get_global_size(1), get_global_size(2), 0};
    //int4 pos = writePos;
    //pos = select(pos, (int4)(2,2,2,0), pos == (int4)(0,0,0,0));
    //pos = select(pos, size-3, pos == size-1);

    // Allocate shared memory
    __local float2 sharedMemory[16*4*8];

    // Read into shared memory
    float4 v = read_imagef(read_vector_field, sampler, writePos);
    sharedMemory[LA(localPos.x,localPos.y,localPos.z, 0)] = v.xy;
    sharedMemory[LA(localPos.x,localPos.y,localPos.z, 1)] = v.zw;

    int3 comp = (localPos == (int3)(0,0,0)) +
        (localPos == (int3)(get_local_size(0)-1,get_local_size(1)-1,get_local_size(2)-1));

    // Synchronize the threads in the group
    barrier(CLK_LOCAL_MEM_FENCE);

    if(comp.x+comp.y+comp.z == 0) {
    // Load data from shared memory and do calculations
    float4 init_vector = read_imagef(init_vector_field, sampler, writePos); // should read from pos
    float3 fx1;
    fx1.xy = sharedMemory[LA(localPos.x+1,localPos.y,localPos.z, 0)];
    fx1.z = sharedMemory[LA(localPos.x+1,localPos.y,localPos.z, 1)].x;
    float3 fx_1;
    fx_1.xy = sharedMemory[LA(localPos.x-1,localPos.y,localPos.z, 0)];
    fx_1.z = sharedMemory[LA(localPos.x-1,localPos.y,localPos.z, 1)].x;
    float3 fy1;
    fy1.xy = sharedMemory[LA(localPos.x,localPos.y+1,localPos.z, 0)];
    fy1.z = sharedMemory[LA(localPos.x,localPos.y+1,localPos.z, 1)].x;
    float3 fy_1;
    fy_1.xy = sharedMemory[LA(localPos.x,localPos.y-1,localPos.z, 0)];
    fy_1.z = sharedMemory[LA(localPos.x,localPos.y-1,localPos.z, 1)].x;
    float3 fz1;
    fz1.xy = sharedMemory[LA(localPos.x,localPos.y,localPos.z+1, 0)];
    fz1.z = sharedMemory[LA(localPos.x,localPos.y,localPos.z+1, 1)].x;
    float3 fz_1;
    fz_1.xy = sharedMemory[LA(localPos.x,localPos.y,localPos.z-1, 0)];
    fz_1.z = sharedMemory[LA(localPos.x,localPos.y,localPos.z-1, 1)].x;
    // Update the vector field: Calculate Laplacian using a 3D central difference scheme
    float3 laplacian = -6*v.xyz + fx1 + fx_1 + fy1 + fy_1 + fz1 + fz_1;

    v.xyz += mu * laplacian - (v.xyz - init_vector.xyz)*init_vector.w;

    write_imagef(write_vector_field, writePos, v);
    }
}

__kernel void GVFResult(__write_only image3d_t result, __read_only image3d_t vectorField) {

    int4 pos = {get_global_id(0), get_global_id(1), get_global_id(2), 0};
    float4 vector = read_imagef(vectorField, sampler, pos);
    vector.w = 0;
    //if(1 < length(vector))
    //    printf("%f %f %f\n", vector.x, vector.y, vector.z);
    write_imagef(result, pos, length(vector));
}


plexfix: handle multi-episodes

plexfix: handle multi-episodes

Handle filename containing multiple episodes.

;; plexfix :: fix filenames for Plex Media Server
;;
;; TODO:
;;  - handle rar files

(eval-when (compile eval load)
  ;;(require :anydate)
  (require :list2)
  (require :acldns)
  (require :smtp)
  (require :osi)
  (require :shell)
  (require :autozoom)
  (require :tget-utils "utils.fasl"))

(defpackage :cl-user
  (:use #:common-lisp
	#:excl
	#:excl.osi
	#:excl.shell
	#:net.post-office))

(in-package :cl-user)

(defvar *debug* nil)
(defvar *no-execute* nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun plexfix (filename &key (stream t)
			      ((:no-execute *no-execute*) *no-execute*))
  (if* (not (probe-file filename))
     then (.error "~a does not exist." filename)
   elseif (file-directory-p filename)
     then (let ((files (directory (pathname-as-directory filename))))
	    (if* (member "rar" files :key #'pathname-type :test #'string=)
	       then (.error "Can't handle rar files yet: ~a." filename)
	       else (dolist (file files)
		      ;; handle mp4 and mkv files, for now, warn of the
		      ;; rest, ignoring some known files
		      (if* (member (pathname-type file) '("mp4" "mkv")
				   :test #'string=)
			 then (plexfix-1 stream file)
		       elseif (member (pathname-type file)
				      '("nfo" "txt" "srt")
				      :test #'string=)
			 thenret
			 else (format stream "Unknown file:~a.~%" file)))))
     else (plexfix-1 stream filename)))

(defun plexfix-1 (stream filename &aux new-name type)
  (multiple-value-bind (series-name season episode pms-fail year month day)
      (parse-name-season-and-episode (file-namestring filename)
				     :episode-required t
				     :junk-allowed t)
    (when (not pms-fail) (return-from plexfix-1 nil))

    ;; PMS will not see this file, so make a symlink for it that it will
    ;; see.
    (setq type (pathname-type filename))
    (setq new-name
      (if* year
	 then ;; date-based name
	      (format nil "~a.~d.~2,'0d.~2,'0d.~a"
		      series-name year month day type)
       elseif (consp episode)
	 then (format nil "~a.S~2,'0dE~2,'0dE~2,'0d.~a"
		      series-name season (car episode) (cdr episode) type)
	 else (format nil "~a.S~2,'0dE~2,'0d.~a"
		      series-name season episode type)))
    (setq new-name (merge-pathnames new-name filename))
    (with-verbosity 1
      (format stream "OLD name: ~a~%" filename)
      (format stream "NEW name: ~a~%" new-name))

    (if* *no-execute*
       then (format stream "Would symlink ~a ~a~%" filename new-name)
       else (symlink filename new-name))

    ;; Look for .srt file with the same name, and make a symlink for that,
    ;; too.  The Roku can't use subtitles unless the file has the same
    ;; name!
    (let ((srt (merge-pathnames (make-pathname :type "srt")
				filename))
	  new-srt)
      (when (probe-file srt)
	(with-verbosity 1
	  (format stream "Making link for srt file, too.~%"))
	(setq new-srt (merge-pathnames (make-pathname :type "srt") new-name))
	(if* *no-execute*
	   then (format stream "Would symlink ~a ~a~%" srt new-srt)
	   else (symlink srt new-srt))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-condition plexfix (error) ())

(defun .error (format-string &rest format-arguments)
  ;; This separates known tget errors from unexpected program errors.  All
  ;; calls to error in this code should be to this function.  Any calls to
  ;; error or cerror cause a stack trace.
  (error 'plexfix :format-control format-string
	 :format-arguments format-arguments))

(defun user::main (&aux (stream t))
  (flet
      ((send-output ()
	 (let ((body (get-output-stream-string stream)))
	   (when (string/= "" body)
	     (ignore-errors
	      (when (not (eq 't stream))
		(send-letter "192.168.0.1"
			     (sys:getenv "USER")
			     (sys:getenv "USER")
			     body
			     :subject "plexfix"))))))
       (doit (&aux torrent-dir torrent-name)
	 (system:with-command-line-arguments
	     (("d" :short debug)
	      ("m" :short no-email)
	      ("n" :short no-execute)
	      ("q" :short quiet)
	      ("v" :short verbose :allow-multiple-options))
	     (rest)
	   (if* (and (null rest)
		     (setq torrent-dir (sys:getenv "TR_TORRENT_DIR"))
		     (setq torrent-name (sys:getenv "TR_TORRENT_NAME")))
	      then ;; called from Transmission
		   (setq rest
		     (list
		      (namestring
		       (merge-pathnames torrent-name
					(pathname-as-directory torrent-dir)))))
	    elseif (or (null rest) (/= 1 (length rest)))
	      then (.error "usage: plexfix file."))
	   (when debug (setq *debug* t))
	   (when no-execute (setq *no-execute* t))
	   (setq *verbose* (or verbose
			       (when quiet 0)
			       1))
	   (when (and (not debug) (not no-email))
	     (setq stream (make-string-output-stream)))
	   (plexfix (car rest) :stream stream))))

    (if* *debug* ;; -d on command line doesn't effect this test!
       then (format t ";;;NOTE: debugging mode is on~%")
	    (doit)
       else (top-level.debug:with-auto-zoom-and-exit (*standard-output*)
	      (handler-case (doit)
		(plexfix (c)
		  ;; 'plexfix errors don't get a backtrace, since those are
		  ;; expected or, at least, planned for.  The unexpected
		  ;; ones get the zoom.
		  (format stream "~&~a~&" c)
		  (send-output)
		  (exit 1 :quiet t)))))
    (send-output)
    (exit 0 :quiet t)))

;; plexfix :: fix filenames for Plex Media Server
;;
;; TODO:
;;  - handle rar files

(eval-when (compile eval load)
  ;;(require :anydate)
  (require :list2)
  (require :acldns)
  (require :smtp)
  (require :osi)
  (require :shell)
  (require :autozoom)
  (require :tget-utils "utils.fasl"))

(defpackage :cl-user
  (:use #:common-lisp
	#:excl
	#:excl.osi
	#:excl.shell
	#:net.post-office))

(in-package :cl-user)

(defvar *debug* nil)
(defvar *no-execute* nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun plexfix (filename &key (stream t)
			      ((:no-execute *no-execute*) *no-execute*))
  (if* (not (probe-file filename))
     then (.error "~a does not exist." filename)
   elseif (file-directory-p filename)
     then (let ((files (directory (pathname-as-directory filename))))
	    (if* (member "rar" files :key #'pathname-type :test #'string=)
	       then (.error "Can't handle rar files yet: ~a." filename)
	       else (dolist (file files)
		      ;; handle mp4 and mkv files, for now, warn of the
		      ;; rest, ignoring some known files
		      (if* (member (pathname-type file) '("mp4" "mkv")
				   :test #'string=)
			 then (plexfix-1 stream file)
		       elseif (member (pathname-type file)
				      '("nfo" "txt" "srt")
				      :test #'string=)
			 thenret
			 else (format stream "Unknown file:~a.~%" file)))))
     else (plexfix-1 stream filename)))

(defun plexfix-1 (stream filename &aux new-name type)
  (multiple-value-bind (series-name season episode pms-fail year month day)
      (parse-name-season-and-episode (file-namestring filename)
				     :episode-required t
				     :junk-allowed t)
    (when (not pms-fail) (return-from plexfix-1 nil))

    ;; PMS will not see this file, so make a symlink for it that it will
    ;; see.
    (setq type (pathname-type filename))
    (setq new-name
      (if* year
	 then ;; date-based name
	      (format nil "~a.~d.~2,'0d.~2,'0d.~a"
		      series-name year month day type)
	 else (format nil "~a.S~2,'0dE~2,'0d.~a"
		      series-name season episode type)))
    (setq new-name (merge-pathnames new-name filename))
    (with-verbosity 1
      (format stream "OLD name: ~a~%" filename)
      (format stream "NEW name: ~a~%" new-name))

    (if* *no-execute*
       then (format stream "Would symlink ~a ~a~%" filename new-name)
       else (symlink filename new-name))

    ;; Look for .srt file with the same name, and make a symlink for that,
    ;; too.  The Roku can't use subtitles unless the file has the same
    ;; name!
    (let ((srt (merge-pathnames (make-pathname :type "srt")
				filename))
	  new-srt)
      (when (probe-file srt)
	(with-verbosity 1
	  (format stream "Making link for srt file, too.~%"))
	(setq new-srt (merge-pathnames (make-pathname :type "srt") new-name))
	(if* *no-execute*
	   then (format stream "Would symlink ~a ~a~%" srt new-srt)
	   else (symlink srt new-srt))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-condition plexfix (error) ())

(defun .error (format-string &rest format-arguments)
  ;; This separates known tget errors from unexpected program errors.  All
  ;; calls to error in this code should be to this function.  Any calls to
  ;; error or cerror cause a stack trace.
  (error 'plexfix :format-control format-string
	 :format-arguments format-arguments))

(defun user::main (&aux (stream t))
  (flet
      ((send-output ()
	 (let ((body (get-output-stream-string stream)))
	   (when (string/= "" body)
	     (ignore-errors
	      (when (not (eq 't stream))
		(send-letter "192.168.0.1"
			     (sys:getenv "USER")
			     (sys:getenv "USER")
			     body
			     :subject "plexfix"))))))
       (doit (&aux torrent-dir torrent-name)
	 (system:with-command-line-arguments
	     (("d" :short debug)
	      ("m" :short no-email)
	      ("n" :short no-execute)
	      ("q" :short quiet)
	      ("v" :short verbose :allow-multiple-options))
	     (rest)
	   (if* (and (null rest)
		     (setq torrent-dir (sys:getenv "TR_TORRENT_DIR"))
		     (setq torrent-name (sys:getenv "TR_TORRENT_NAME")))
	      then ;; called from Transmission
		   (setq rest
		     (list
		      (namestring
		       (merge-pathnames torrent-name
					(pathname-as-directory torrent-dir)))))
	    elseif (or (null rest) (/= 1 (length rest)))
	      then (.error "usage: plexfix file."))
	   (when debug (setq *debug* t))
	   (when no-execute (setq *no-execute* t))
	   (setq *verbose* (or verbose
			       (when quiet 0)
			       1))
	   (when (and (not debug) (not no-email))
	     (setq stream (make-string-output-stream)))
	   (plexfix (car rest) :stream stream))))

    (if* *debug* ;; -d on command line doesn't effect this test!
       then (format t ";;;NOTE: debugging mode is on~%")
	    (doit)
       else (top-level.debug:with-auto-zoom-and-exit (*standard-output*)
	      (handler-case (doit)
		(plexfix (c)
		  ;; 'plexfix errors don't get a backtrace, since those are
		  ;; expected or, at least, planned for.  The unexpected
		  ;; ones get the zoom.
		  (format stream "~&~a~&" c)
		  (send-output)
		  (exit 1 :quiet t)))))
    (send-output)
    (exit 0 :quiet t)))


Fixed error in the GEOTRAN syntax

Fixed error in the GEOTRAN syntax

####FIRST: Please check the contents and comments of GEOMAP.PARAM!!!###
####You'll need to make sure IRAF and the GEOMAP parameters are setup nicely
#################################PART 1: Run GEOMAP##########################

##### Run these commands inside of IRAF after adjusting parameters of geomap :)
#First command - for the standard star (1):

geomap GEOTRAN_STD01.DAT TRANSPARS01 1 320 1 240

#Explanation:
## The GEOTRAN...DAT files were generated by q_transtable2 commands, which themselve were generated by WL_CAL_A_B.f
## TRANSPARA is the output file
## The last four parameters give the (X,Y) pixel range of the image - in this case, NL Low Res spectroscopic data
#Run the object commands (32):
geomap GEOTRAN_OBJ01.DAT TRANSPARA01 1 320 1 240
geomap GEOTRAN_OBJ02.DAT TRANSPARA02 1 320 1 240
geomap GEOTRAN_OBJ03.DAT TRANSPARA03 1 320 1 240
geomap GEOTRAN_OBJ04.DAT TRANSPARA04 1 320 1 240
geomap GEOTRAN_OBJ05.DAT TRANSPARA05 1 320 1 240
geomap GEOTRAN_OBJ06.DAT TRANSPARA06 1 320 1 240
geomap GEOTRAN_OBJ07.DAT TRANSPARA07 1 320 1 240
geomap GEOTRAN_OBJ08.DAT TRANSPARA08 1 320 1 240
geomap GEOTRAN_OBJ09.DAT TRANSPARA09 1 320 1 240
geomap GEOTRAN_OBJ010.DAT TRANSPARA10 1 320 1 240
geomap GEOTRAN_OBJ011.DAT TRANSPARA11 1 320 1 240
geomap GEOTRAN_OBJ012.DAT TRANSPARA12 1 320 1 240
geomap GEOTRAN_OBJ013.DAT TRANSPARA13 1 320 1 240
geomap GEOTRAN_OBJ014.DAT TRANSPARA14 1 320 1 240
geomap GEOTRAN_OBJ015.DAT TRANSPARA15 1 320 1 240
geomap GEOTRAN_OBJ016.DAT TRANSPARA16 1 320 1 240
geomap GEOTRAN_OBJ017.DAT TRANSPARB01 1 320 1 240
geomap GEOTRAN_OBJ018.DAT TRANSPARB02 1 320 1 240
geomap GEOTRAN_OBJ019.DAT TRANSPARB03 1 320 1 240
geomap GEOTRAN_OBJ020.DAT TRANSPARB04 1 320 1 240
geomap GEOTRAN_OBJ021.DAT TRANSPARB05 1 320 1 240
geomap GEOTRAN_OBJ022.DAT TRANSPARB06 1 320 1 240
geomap GEOTRAN_OBJ023.DAT TRANSPARB07 1 320 1 240
geomap GEOTRAN_OBJ024.DAT TRANSPARB08 1 320 1 240
geomap GEOTRAN_OBJ025.DAT TRANSPARB09 1 320 1 240
geomap GEOTRAN_OBJ026.DAT TRANSPARB10 1 320 1 240
geomap GEOTRAN_OBJ027.DAT TRANSPARB11 1 320 1 240
geomap GEOTRAN_OBJ028.DAT TRANSPARB12 1 320 1 240
geomap GEOTRAN_OBJ029.DAT TRANSPARB13 1 320 1 240
geomap GEOTRAN_OBJ030.DAT TRANSPARB14 1 320 1 240
geomap GEOTRAN_OBJ031.DAT TRANSPARB15 1 320 1 240
geomap GEOTRAN_OBJ032.DAT TRANSPARB16 1 320 1 240

###############Part 2: The next batch of GEOMAP COMMANDS################

#First command - for the standard star (1):

geotran NL_STD_NC_FC_A01.fits NL_STD_A01N.fits TRANSPARS01 GEOTRAN_STD01.DAT
geotran NL_OBJ_NC_FC_A01.fits NL_OBJ_A01N.fits TRANSPARA01 GEOTRAN_OBJ01.DAT
geotran NL_OBJ_NC_FC_A02.fits NL_OBJ_A02N.fits TRANSPARA02 GEOTRAN_OBJ02.DAT
geotran NL_OBJ_NC_FC_A03.fits NL_OBJ_A03N.fits TRANSPARA03 GEOTRAN_OBJ03.DAT
geotran NL_OBJ_NC_FC_A04.fits NL_OBJ_A04N.fits TRANSPARA04 GEOTRAN_OBJ04.DAT
geotran NL_OBJ_NC_FC_A05.fits NL_OBJ_A05N.fits TRANSPARA05 GEOTRAN_OBJ05.DAT
geotran NL_OBJ_NC_FC_A06.fits NL_OBJ_A06N.fits TRANSPARA06 GEOTRAN_OBJ06.DAT
geotran NL_OBJ_NC_FC_A07.fits NL_OBJ_A07N.fits TRANSPARA07 GEOTRAN_OBJ07.DAT
geotran NL_OBJ_NC_FC_A08.fits NL_OBJ_A08N.fits TRANSPARA08 GEOTRAN_OBJ08.DAT
geotran NL_OBJ_NC_FC_A09.fits NL_OBJ_A09N.fits TRANSPARA09 GEOTRAN_OBJ09.DAT
geotran NL_OBJ_NC_FC_A10.fits NL_OBJ_A10N.fits TRANSPARA10 GEOTRAN_OBJ010.DAT
geotran NL_OBJ_NC_FC_A11.fits NL_OBJ_A11N.fits TRANSPARA11 GEOTRAN_OBJ011.DAT
geotran NL_OBJ_NC_FC_A12.fits NL_OBJ_A12N.fits TRANSPARA12 GEOTRAN_OBJ012.DAT
geotran NL_OBJ_NC_FC_A13.fits NL_OBJ_A13N.fits TRANSPARA13 GEOTRAN_OBJ013.DAT
geotran NL_OBJ_NC_FC_A14.fits NL_OBJ_A14N.fits TRANSPARA14 GEOTRAN_OBJ014.DAT
geotran NL_OBJ_NC_FC_A15.fits NL_OBJ_A15N.fits TRANSPARA15 GEOTRAN_OBJ015.DAT
geotran NL_OBJ_NC_FC_A16.fits NL_OBJ_A16N.fits TRANSPARA16 GEOTRAN_OBJ016.DAT
geotran NL_OBJ_NC_FC_B01.fits NL_OBJ_B01N.fits TRANSPARB01 GEOTRAN_OBJ017.DAT
geotran NL_OBJ_NC_FC_B02.fits NL_OBJ_B02N.fits TRANSPARB02 GEOTRAN_OBJ018.DAT
geotran NL_OBJ_NC_FC_B03.fits NL_OBJ_B03N.fits TRANSPARB03 GEOTRAN_OBJ019.DAT
geotran NL_OBJ_NC_FC_B04.fits NL_OBJ_B04N.fits TRANSPARB04 GEOTRAN_OBJ020.DAT
geotran NL_OBJ_NC_FC_B05.fits NL_OBJ_B05N.fits TRANSPARB05 GEOTRAN_OBJ021.DAT
geotran NL_OBJ_NC_FC_B06.fits NL_OBJ_B06N.fits TRANSPARB06 GEOTRAN_OBJ022.DAT
geotran NL_OBJ_NC_FC_B07.fits NL_OBJ_B07N.fits TRANSPARB07 GEOTRAN_OBJ023.DAT
geotran NL_OBJ_NC_FC_B08.fits NL_OBJ_B08N.fits TRANSPARB08 GEOTRAN_OBJ024.DAT
geotran NL_OBJ_NC_FC_B09.fits NL_OBJ_B09N.fits TRANSPARB09 GEOTRAN_OBJ025.DAT
geotran NL_OBJ_NC_FC_B10.fits NL_OBJ_B10N.fits TRANSPARB10 GEOTRAN_OBJ026.DAT
geotran NL_OBJ_NC_FC_B11.fits NL_OBJ_B11N.fits TRANSPARB11 GEOTRAN_OBJ027.DAT
geotran NL_OBJ_NC_FC_B12.fits NL_OBJ_B12N.fits TRANSPARB12 GEOTRAN_OBJ028.DAT
geotran NL_OBJ_NC_FC_B13.fits NL_OBJ_B13N.fits TRANSPARB13 GEOTRAN_OBJ029.DAT
geotran NL_OBJ_NC_FC_B14.fits NL_OBJ_B14N.fits TRANSPARB14 GEOTRAN_OBJ030.DAT
geotran NL_OBJ_NC_FC_B15.fits NL_OBJ_B15N.fits TRANSPARB15 GEOTRAN_OBJ031.DAT
geotran NL_OBJ_NC_FC_B16.fits NL_OBJ_B16N.fits TRANSPARB16 GEOTRAN_OBJ032.DAT

####FIRST: Please check the contents and comments of GEOMAP.PARAM!!!###
####You'll need to make sure IRAF and the GEOMAP parameters are setup nicely
#################################PART 1: Run GEOMAP##########################

##### Run these commands inside of IRAF after adjusting parameters of geomap :)
#First command - for the standard star (1):

geomap GEOTRAN_STD01.DAT TRANSPARS01 1 320 1 240

#Explanation:
## The GEOTRAN...DAT files were generated by q_transtable2 commands, which themselve were generated by WL_CAL_A_B.f
## TRANSPARA is the output file
## The last four parameters give the (X,Y) pixel range of the image - in this case, NL Low Res spectroscopic data
#Run the object commands (32):
geomap GEOTRAN_OBJ01.DAT TRANSPARA01 1 320 1 240
geomap GEOTRAN_OBJ02.DAT TRANSPARA02 1 320 1 240
geomap GEOTRAN_OBJ03.DAT TRANSPARA03 1 320 1 240
geomap GEOTRAN_OBJ04.DAT TRANSPARA04 1 320 1 240
geomap GEOTRAN_OBJ05.DAT TRANSPARA05 1 320 1 240
geomap GEOTRAN_OBJ06.DAT TRANSPARA06 1 320 1 240
geomap GEOTRAN_OBJ07.DAT TRANSPARA07 1 320 1 240
geomap GEOTRAN_OBJ08.DAT TRANSPARA08 1 320 1 240
geomap GEOTRAN_OBJ09.DAT TRANSPARA09 1 320 1 240
geomap GEOTRAN_OBJ010.DAT TRANSPARA10 1 320 1 240
geomap GEOTRAN_OBJ011.DAT TRANSPARA11 1 320 1 240
geomap GEOTRAN_OBJ012.DAT TRANSPARA12 1 320 1 240
geomap GEOTRAN_OBJ013.DAT TRANSPARA13 1 320 1 240
geomap GEOTRAN_OBJ014.DAT TRANSPARA14 1 320 1 240
geomap GEOTRAN_OBJ015.DAT TRANSPARA15 1 320 1 240
geomap GEOTRAN_OBJ016.DAT TRANSPARA16 1 320 1 240
geomap GEOTRAN_OBJ017.DAT TRANSPARB01 1 320 1 240
geomap GEOTRAN_OBJ018.DAT TRANSPARB02 1 320 1 240
geomap GEOTRAN_OBJ019.DAT TRANSPARB03 1 320 1 240
geomap GEOTRAN_OBJ020.DAT TRANSPARB04 1 320 1 240
geomap GEOTRAN_OBJ021.DAT TRANSPARB05 1 320 1 240
geomap GEOTRAN_OBJ022.DAT TRANSPARB06 1 320 1 240
geomap GEOTRAN_OBJ023.DAT TRANSPARB07 1 320 1 240
geomap GEOTRAN_OBJ024.DAT TRANSPARB08 1 320 1 240
geomap GEOTRAN_OBJ025.DAT TRANSPARB09 1 320 1 240
geomap GEOTRAN_OBJ026.DAT TRANSPARB10 1 320 1 240
geomap GEOTRAN_OBJ027.DAT TRANSPARB11 1 320 1 240
geomap GEOTRAN_OBJ028.DAT TRANSPARB12 1 320 1 240
geomap GEOTRAN_OBJ029.DAT TRANSPARB13 1 320 1 240
geomap GEOTRAN_OBJ030.DAT TRANSPARB14 1 320 1 240
geomap GEOTRAN_OBJ031.DAT TRANSPARB15 1 320 1 240
geomap GEOTRAN_OBJ032.DAT TRANSPARB16 1 320 1 240

###############Part 2: The next batch of GEOMAP COMMANDS################

#First command - for the standard star (1):

geotran NL_STD_NC_FC_A01.fits NL_STD_A01N.fits TRANSPARS01 GEOTRAN_STD01.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_A01.fits NL_OBJ_A01N.fits TRANSPARA01 GEOTRAN_OBJ01.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_A02.fits NL_OBJ_A02N.fits TRANSPARA02 GEOTRAN_OBJ02.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_A03.fits NL_OBJ_A03N.fits TRANSPARA03 GEOTRAN_OBJ03.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_A04.fits NL_OBJ_A04N.fits TRANSPARA04 GEOTRAN_OBJ04.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_A05.fits NL_OBJ_A05N.fits TRANSPARA05 GEOTRAN_OBJ05.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_A06.fits NL_OBJ_A06N.fits TRANSPARA06 GEOTRAN_OBJ06.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_A07.fits NL_OBJ_A07N.fits TRANSPARA07 GEOTRAN_OBJ07.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_A08.fits NL_OBJ_A08N.fits TRANSPARA08 GEOTRAN_OBJ08.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_A09.fits NL_OBJ_A09N.fits TRANSPARA09 GEOTRAN_OBJ09.DAT 1 320 1 204 1 240
geotran NL_OBJ_NC_FC_A10.fits NL_OBJ_A10N.fits TRANSPARA10 GEOTRAN_OBJ010.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_A11.fits NL_OBJ_A11N.fits TRANSPARA11 GEOTRAN_OBJ011.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_A12.fits NL_OBJ_A12N.fits TRANSPARA12 GEOTRAN_OBJ012.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_A13.fits NL_OBJ_A13N.fits TRANSPARA13 GEOTRAN_OBJ013.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_A14.fits NL_OBJ_A14N.fits TRANSPARA14 GEOTRAN_OBJ014.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_A15.fits NL_OBJ_A15N.fits TRANSPARA15 GEOTRAN_OBJ015.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_A16.fits NL_OBJ_A16N.fits TRANSPARA16 GEOTRAN_OBJ016.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_B01.fits NL_OBJ_B01N.fits TRANSPARB01 GEOTRAN_OBJ017.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_B02.fits NL_OBJ_B02N.fits TRANSPARB02 GEOTRAN_OBJ018.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_B03.fits NL_OBJ_B03N.fits TRANSPARB03 GEOTRAN_OBJ019.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_B04.fits NL_OBJ_B04N.fits TRANSPARB04 GEOTRAN_OBJ020.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_B05.fits NL_OBJ_B05N.fits TRANSPARB05 GEOTRAN_OBJ021.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_B06.fits NL_OBJ_B06N.fits TRANSPARB06 GEOTRAN_OBJ022.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_B07.fits NL_OBJ_B07N.fits TRANSPARB07 GEOTRAN_OBJ023.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_B08.fits NL_OBJ_B08N.fits TRANSPARB08 GEOTRAN_OBJ024.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_B09.fits NL_OBJ_B09N.fits TRANSPARB09 GEOTRAN_OBJ025.DAT 1 320 1 204 1 240
geotran NL_OBJ_NC_FC_B10.fits NL_OBJ_B10N.fits TRANSPARB10 GEOTRAN_OBJ026.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_B11.fits NL_OBJ_B11N.fits TRANSPARB11 GEOTRAN_OBJ027.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_B12.fits NL_OBJ_B12N.fits TRANSPARB12 GEOTRAN_OBJ028.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_B13.fits NL_OBJ_B13N.fits TRANSPARB13 GEOTRAN_OBJ029.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_B14.fits NL_OBJ_B14N.fits TRANSPARB14 GEOTRAN_OBJ030.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_B15.fits NL_OBJ_B15N.fits TRANSPARB15 GEOTRAN_OBJ031.DAT 1 320 1 240 1 240
geotran NL_OBJ_NC_FC_B16.fits NL_OBJ_B16N.fits TRANSPARB16 GEOTRAN_OBJ032.DAT 1 320 1 240 1 240


Split out parallelisation.

Split out parallelisation.

Make more readable in general.

; PI Common LISP example.

; Abstract getting command line arguments.
; In sbcl the interpreter is an extra argument.

; For SBCL: sbcl --script pi.cl <n>

; This implementation checks OMP_NUM_THREADS for number of threads or uses
; a single thread if not present.

; Get arguments
(defun getargs ()
  (or
   #+SBCL (cdr *posix-argv*)
   nil))

; Get environment variable/.
(defun getenvvar (name)
  (or
   #+SBCL (sb-unix::posix-getenv name)
   nil))

; Version of calcpi that operates on part of the range
(defun calcpi (n fst fnl)
  (/ (loop for i from fst to fnl
	sum (/ 4.d0 (+ 1.d0 (expt (* (- i 0.5d0) (/ 1.d0 n)) 2 ))))
	 n)
)

; Thread paralle pi calculation
; Uses SBCL threads so non-portable
(defun parapi (n threads)
   (let ((fst 0)  ; first iter index
         (fnl n)  ; final iter index
         (chunk)  ; size of a thread chunk
         (left)   ; leftovers from uneven parallelisation
         (p 0)    ; value of pi
         (tl nil)); threads list
      (setq chunk (floor (/ n threads)))
      (setq left  (- n (* chunk threads)))

      ; Create threads and set them off.
      (loop for j from 0 to (- threads 1) do
         (setq fst (* j chunk))
         (setq fnl (- (* (+ j 1) chunk) 1))
         (if (= j (- threads 1))    ; if we are the last thread also do
            (setq fnl (+ fnl left)) ; leftovers in this thread
         )
         (format t "DEBUG: Thread ~a from ~a to ~a~%" j fst fnl)
         (setq tl (cons (sb-thread:make-thread (lambda () (calcpi n fst fnl))) tl))
      )

      ; Join threads and gather results.
      (loop for item in tl
         do (setq p (+ p (sb-thread:join-thread item)))
      )
      p
   )
)

; Our main body
(defvar n 50000000)
(defvar threads 1)

(if (> (list-length(getargs)) 0)
  (setq n (parse-integer (car (getargs))))
)

; Choose thread count based on OMP_NUM_THREADS.
(if (> (length(getenvvar "OMP_NUM_THREADS")) 0)
  (setq threads (parse-integer (getenvvar "OMP_NUM_THREADS")))
  (format t "DEBUG: OMP_NUM_THREADS not set - defaulting to 1~%")
)

(format t "Calculating PI using:~%")
(format t "  ~a slices~%" n)
(format t "  ~a thread(s)~%" threads)

; get-internal-real-time gets time from some arbitrary, implementation
; dependent starting point in some fraction of a second.
(defvar start (get-internal-real-time))

; Perform calculation
(defvar p (parapi n threads))

; get-internal-real-time is in some platform specific unit which we can find in
; internal-time-units-per-second
(defvar stop (get-internal-real-time))
(defvar runt (/ (- stop start) internal-time-units-per-second))

(format t "Obtained value of PI: ~a~%" p)

; We have to print the time with ~f to force a float output.
(format t "Time taken: ~f seconds~%" runt)

; PI Common LISP example.

; Abstract getting command line arguments.
; In sbcl the interpreter is an extra argument.

; For SBCL: sbcl --script pi.cl <n>

(defun getargs ()
  (or
   #+SBCL (cdr *posix-argv*)
   nil))

(defun getenvvar (name)
  (or
   #+SBCL (sb-unix::posix-getenv name)
   nil))

(defun calcpi (n fst fnl)
  (/ (loop for i from fst to fnl
	sum (/ 4.d0 (+ 1.d0 (expt (* (- i 0.5d0) (/ 1.d0 n)) 2 ))))
	 n)
)

(defvar n 50000000)
(defvar threads 1)

(if (> (list-length(getargs)) 0)
  (setq n (parse-integer (car (getargs))))
)

; Choose thread count based on OMP_NUM_THREADS.
(if (> (length(getenvvar "OMP_NUM_THREADS")) 0)
  (setq threads (parse-integer (getenvvar "OMP_NUM_THREADS")))
  (format t "DEBUG: OMP_NUM_THREADS not set - defaulting to 1~%")
)

(format t "Calculating PI using:~%")
(format t "  ~a slices~%" n)
(format t "  ~a thread(s)~%" threads)

; get-internal-real-time gets time from some arbitrary, implementation
; dependent starting point in some fraction of a second.
(defvar start (get-internal-real-time))

; This is SBCL specific.
(defvar fst 0)
(defvar fnl n)
(defvar chunk (floor (/ n threads)))
(defvar left (- n (* chunk threads)))
(defvar p 0)
(defvar tl nil)
(loop for j from 0 to (- threads 1) do
   (setq fst (* j chunk))
   (setq fnl (- (* (+ j 1) chunk) 1))
   (if (= j (- threads 1))
      (setq fnl (+ fnl left))
   )
   (format t "DEBUG: Thread ~a from ~a to ~a~%" j fst fnl)
   (setq tl (cons (sb-thread:make-thread (lambda () (calcpi n fst fnl))) tl))
)

(loop for item in tl
   do (setq p (+ p (sb-thread:join-thread item)))
)
; get-internal-real-time is in some platform specific unit which we can find in
; internal-time-units-per-second
(defvar stop (get-internal-real-time))

(defvar runt (/ (- stop start) internal-time-units-per-second))

(format t "Obtained value of PI: ~a~%" p)

; We have to print the time with ~f to force a float output.
(format t "Time taken: ~f seconds~%" runt)


got pango rendering working, and binaries work again as well

(proclaim '(optimize (speed 0) (safety 3) (debug 3)))

(ql:quickload '(alexandria iterate anaphora cl-cairo2 cl-cairo2-xlib cl-pango) :silent t)

(defpackage arboreta
  (:use cl iterate anaphora cl-cairo2))

(in-package arboreta)

(defparameter context nil)
(defparameter layout nil)
(defparameter font nil)

(defparameter w 600)
(defparameter h 400)

(defun main ()
   (setf context (create-xlib-image-context w h :window-name "pango-test"))
   (let ((cairo::*context* context))
      (set-source-rgb 37/255 46/255 50/255)
      (paint)

      (translate 0 0)
      (set-source-rgb 148/255 163/255 165/255)

      ;; had to do it without the helper macros, because they cause context errors for some reason
      ;; you might not have this font, change it to something you do have.

      ;; sometimes the window doesn't display the text, it should work if you close out the window
      ;; and re-run (arboreta::main) from the REPL

      ;; it seems to be time based, I can't tell if the text isn't rendering at all, or if it's just
      ;; the same color as the background, or the background is getting rendered first.

      ;; we're going to need to macro the shit out of this

      (setf layout (pango:pango_cairo_create_layout (slot-value context 'cairo::pointer)))
      (setf font (pango:pango_font_description_from_string "Fantasque Sans Mono 12"))
      (pango:pango_layout_set_font_description layout font)

      (cairo:save)

      (pango:pango_layout_set_text layout "Hello, glorious pango text rendering!" -1)
      (pango:pango_cairo_update_layout (slot-value context 'cairo::pointer) layout)
      (pango:pango_cairo_show_layout (slot-value context 'cairo::pointer) layout)

      (cairo:restore)

      (sleep 5)))

;; (sb-ext:save-lisp-and-die "arboreta" :toplevel #'main :executable t)
(main)

(proclaim '(optimize (speed 0) (safety 3) (debug 3)))

(ql:quickload '(alexandria iterate anaphora cl-glut) :silent t)

(defpackage arboreta
  (:use cl iterate anaphora alexandria))

(in-package arboreta)

(defclass hello-window (glut:window)
  ()
  (:default-initargs :pos-x 100 :pos-y 100 :width 250 :height 250
                     :mode '(:single :rgb) :title "hello.lisp"))

(defmethod glut:display-window :before ((w hello-window))
  ;; Select clearing color.
  (gl:clear-color 0 0 0 0)
  ;; Initialize viewing values.
  (gl:matrix-mode :projection)
  (gl:load-identity)
  (gl:ortho 0 1 0 1 -1 1))

(defmethod glut:display ((w hello-window))
  (gl:clear :color-buffer)
  ;; Draw white polygon (rectangle) with corners at
  ;; (0.25, 0.25, 0.0) and (0.75, 0.75, 0.0).
  (gl:color 1 1 1)
  (gl:with-primitive :polygon
    (gl:vertex 0.25 0.25 0)
    (gl:vertex 0.75 0.25 0)
    (gl:vertex 0.75 0.75 0)
    (gl:vertex 0.25 0.75 0))
  ;; Start processing buffered OpenGL routines.
  (gl:flush))

(defun main () (glut:display-window (make-instance 'hello-window)))

(sb-ext:save-lisp-and-die "arboreta" :toplevel #'main :executable t)


fix non-power of 2 opencl workgroup size bug.


version 1.27 fixes for set-torrent-handler/pathname

The pathname case of set-torrent-handler now works.


we need a git hook to untabify or something

(proclaim '(optimize (speed 0) (safety 3) (debug 3)))

(ql:quickload '(alexandria iterate anaphora cl-cairo2 cl-cairo2-xlib cl-pango) :silent t)

(defpackage arboreta
  (:use cl iterate anaphora cl-cairo2))

(in-package arboreta)

(defparameter context nil)
(defparameter layout nil)
(defparameter font nil)

(defparameter w 600)
(defparameter h 400)

(defun main ()
   (setf context (create-xlib-image-context w h :window-name "pango-test"))
   (with-context (context)
      (set-source-rgb 1 1 1)
      (rectangle 0 0 w h)
      (fill-path)

      ;; had to do it without the helper macros, because they cause context errors for some reason
      ;; you might not have this font, change it to a good non-bitmap monospaced font you do have.

      ;; we're going to need to macro the shit out of this

      (setf layout (pango:pango_cairo_create_layout (slot-value cairo:*context* 'cairo::pointer)))
      (setf font (pango:pango_font_description_from_string "Fantasque Sans Mono 12"))
      (pango:pango_layout_set_font_description layout font)

      ;; (cairo:save)

      (pango:pango_layout_set_text layout
         (format nil "~{~a~%~}"
            '("Hello, glorious pango text rendering!"
              "いあだ〜〜ずかしいです〜〜"
              "Τη γλώσσα μου έδωσαν ελληνική"
              "ᚠᛇᚻ᛫ᛒᛦᚦ᛫ᚠᚱᚩᚠᚢᚱ᛫ᚠᛁᚱᚪ᛫ᚷᛖᚻᚹᛦᛚᚳᚢᛗ"
              "ಬಾ ಇಲ್ಲಿ ಸಂಭವಿಸು ಇಂದೆನ್ನ ಹೃದಯದಲಿ "
              "मैं काँच खा सकता हूँ और मुझे उससे कोई चोट नहीं पहुंचती"))
         -1)

      (new-path)
      (move-to 0 0)
      (set-source-rgb 81/255 81/255 81/255)

      (pango:pango_cairo_update_layout (slot-value *context* 'cairo::pointer) layout)
      (pango:pango_cairo_layout_path (slot-value *context* 'cairo::pointer) layout)
      (fill-preserve)

      ;; (cairo:restore)

      (princ "press enter here to exit")
      (finish-output)
      (when (read-line)
         (cairo:destroy context))
         (sb-ext:exit)))

(sb-ext:save-lisp-and-die "arboreta" :toplevel #'main :executable t)
;;(main)