# Category : Files from Magazines

Archive : DDJ-9008.ZIP

Filename : LAUZZANA.LST

by G. Raymond Lauzzana and Denise E.M. Penrose

[LISTING ONE]

/* include all of the files that you might need. */

#include

#include

#include

#include

#include

#include

#include

#include

#include

#include

#include

#include

#include

#include

#include

#include

#include

#include

#include

#include

#include

#include

#include

/* --------------------------------------------------------------------- */

/* The low-level help functions for graphics. */

/* Mean-squared distance between to coordinate pairs. */

int distance(i0, j0, i1, j1)

int i0, j0, i1, j1;

{ int res;

double x1, x2, y1, y2;

x1 = i0; x2 = i1; y1 = j0; y2 = j1;

res = sqrt((x1-x2)*(x1-x2) + (y1-y2)*(y1-y2));

return(res);

}

/* --------------------------------------------------------------------- */

/* The low-level SPLINE function. This function calculates and draws a

curved line along the path of a bi-cubic spline the equation for a coordinate

of the points on the spline is:

j = j1*t + j2*(1 - t) + W*(j2-j3)*t*(1 - t)*(1 - t) + W*(j1-j0)*t*t*(1 - t);

where: j : the coordinate being calculated.

t : the cubic variable.

W : a weighting factor.

(j1, j2) : the end-coordinates of the spline.

(j0, j3) : The control coordinates.

*/

_Spline (i0, j0, i1, j1, i2, j2, i3, j3)

int i0, j0, i1, j1, i2, j2, i3, j3;

{ float dt, t0, t1, t2, t3, t5, inc, dist, W;

int i, j, i5, j5, count;

inc = 2.5; /* Two pixel wide sampling rate */

W = 0.9; /* Set the weighting factor. */

MoveTo(j1, i1); /* Move to P1 */

dist = distance(i1, j1, i2, j2); /* The distance between the two points*/

if (inc < dist)

{ j5 = j1-j0;

i5 = i1-i0;

j3 = j2-j3;

i3 = i2-i3;

dt = inc/dist; /* Transform the sampling rate to a function of T */

count = 1.0/dt; /* Number of samples to be taken in a unit interval */

while (count-- > 0)

{ t1 = dt*count; /* calculate I and J as a function of T */

t2 = 1.0 - t1; /* (1 - t) */

t5 = W*t1*t1*t2; /* W*t*t*(1 - t) */

t3 = W*t1*t2*t2; /* W*t*(1 - t)*(1 - t) */

j = j1*t1 + j2*t2 + t3*j3 + j5*t5;

i = i1*t1 + i2*t2 + t3*i3 + i5*t5;

LineTo(j, i);

} }

else LineTo(i2, j2);

}

[LISTING TWO]

;; ----------------------------------------------------------------------

;; You need to change this to the directory where you have stored FF.fasl

(load "Lauzzana:Ray:Projects:Artifex:LLIB:FF")

;; ----------------------------------------------------------------------

;; You need to change this to the directory where C libraries is stored

(def-logical-pathname "CLIB;" "Lauzzana:Ray:Projects:Artifex:CLIB")

;; ----------------------------------------------------------------------

;; The high-level SPLINE function

(defun SPLINE (&rest p)

"

SPLINE (&rest point-list)

Sets up the front window as a graphics port to draw in, and calls

DO-SPLINE to do the actual work of drawing a spline.

"

(with-port (ask (front-window) wptr) (do-spline p)))

(defun DO-SPLINE (p)

"

D0-SPLINE (point-list)

A smooth curve coonecting the points.

"

(let ((p1 (car p))

(p2 (cadr p))

(p3 (caddr p))

(p4 (cadr (cddr p)))

(p5 (cadr (cdddr p))))

(cond ((or (null (pointp p1)) (null (pointp p4))) nil)

((and (pointp p1) (pointp p2) (pointp p3) (pointp p4))

(_Spline (I-coord p1)

(J-coord p1)

(I-coord p2)

(J-coord p2)

(I-coord p3)

(J-coord p3)

(I-coord p4)

(J-coord p4))

(if (pointp p5)

(append (list 'SPLINE p1) (cdr (DO-SPLINE (cdr p))))

(cons 'SPLINE p))))))

;; ----------------------------------------------------------------------

;; The high-level help functions for graphics

;; @@, representation for a point.

(defun @@ (a &optional b)

"

@@ () or (I-coordinate J-coordinate) or (integer)

A single user point or a point.

A screen location, in physical coordinates. (@@ 0 0) is the upper-left

corner. If single integer is recieved it is interpretted as a packed point,

and it is unpacked into a coordinate pair.

"

(cond ((and (numberp a) (numberp b)) (list '@@ (round a) (round b)))

((numberp a) (let ((i (floor (/ a 65536))))

(list '@@ i (- a (* 65536 i)))))))

;; The type test for a POINT.

(defun POINTP (p)

"

POINTP (item)

If the item is a point represented in in coordinates, ie. (@@ I J)

then TRUE, else NIL.

"

(and (listp p)

(or (= 3 (length p)) (= 2 (length p))) (equal (car p) '@@)))

;; I-COORDINATE

(defun I-COORD (p)

"

I-COORD (point)

Returns the vertical screen coordinate of a point.

"

(if (pointp p) (cadr p)))

;; J-COORDINATE

(defun J-COORD (p)

"

J-COORD (point)

Returns the horizontal screen coordinate of a point.

"

(if (pointp p) (caddr p)))

;; ----------------------------------------------------------------------

;; The binding to the low-level SPLINE function

;; There are two methods to bind a C function to Allegro.

;; The first method uses DEFFCFUN. Though this is a simpler function,

;; The binding will be lost if you build a stand-alone application.

;; Using DEFFCFUN the code would be:

;; (deffcfun (Mac_Spline "_Spline")

;; (integer integer integer integer integer integer integer integer) :novalue)

;; The second and preferred method uses MULTIPLE-VALUE-BIND and FF-CALL

;; to bind a physical entry-point to a symbol. This is a hardware dependent

;; solution, in that you need to represent the binding in terms of the

;; physical size and ordering of the machines stack. In the case of the

;; Mac II, parameters are stored in reverse order on the stack. Therefore,

;; the foreign function call must reverse the order of the parameters.

;; MULTIPLE-VALUE-BIND is used to perform the mapping of parametes.

;; FF-LOOKUP-ENTRY find the physical address of the entry-point for function.

;; FF-CALL executes the coda stored at a physical address.

(defun _Spline (a b c d e f g h)

"

_Spline (i0 j0 i1 j1 i2 j2 i3 j3)

Draws a spline between p1 and p2 to the control points p0 and p3.

"

(multiple-value-bind (entry a5) (ff-lookup-entry "_Spline")

(ff-call entry

:a5 a5 :long h :long g :long f :long e :long d :long c :long b :long a

:novalue)))

;; ----------------------------------------------------------------------

;; The loading the low-level SPLINE function

;; FF-LOAD is used to load binary files and their associated libraries.

;; In this case the object module for the function _Spline is stored in

;; the file

;; _Spline and load the binary code associated with it.

;; In addition, it searches the libraries for unsatisfied symbolic references

;; which which may have occurred within the code and loads them as well.

;; In otherwords, it links and loads.

;; You need to change this to the directory where you have stored your C spline

(ff-load "Lauzzana:Ray:Papers:Spline:spline.c.o"

:entry-names

(list "_Spline" )

:libraries

(list "CLIB;StdCLib.o" "CLIB;CRuntime.o" "CLIB;CInterface.o"

"CLIB;math.o" "CLIB;CSANElib.o"))

[Example 1: Cubic equations]

j = j1t + j2(1 - t) + W(j2 - j3)(1 - t)2t + W(j1 - j0)(1 - t)t2

i = i1t + i2(1 - t) + W(i2 - i3)(1 - t)2t + W(i1 - i0)(1 - t)t2

[Example 2: Calculating coordinates]

while (t < 1)

{ j = j1*t + j2*(1 - t) + W*(j2-j3)*t*(1 - t)*(1 - t) + W*(j1-j0)*t*t*(1 - t);

i = i1*t + i2*(1 - t) + W*(i2-i3)*t*(1 - t)*(1 - t) + W*(i1-i0)*t*t*(1 - t);

t = t + dt;

LineTo(i,j);

}

[Example 3: Partitioning the equation shown in Example 2.]

while (t1 < 1)

{ t1 = t1 + dt;

t2 = 1.0 - t1;

t5 = W*t1*t1*t2;

t3 = W*t1*t2*t2;

j = j1*t1 + j2*t2 + t3*j3 + j5*t5;

i = i1*t1 + i2*t2 + t3*i3 + i5*t5;

LineTo(j, i);

}

[Example 4: Loading the C routine]

(a)

(require 'FF)

(b)

(load "

(c)

(def-logical-pathname "CLIB;" "

(d)

(ff-load "

:entry-names

(list "_Spline" )

:libraries

(list "CLIB;StdCLib.o" "CLIB;CRuntime.o" "CLIB;CInterface.o"

"CLIB;math.o" "CLIB;CSANElib.o"))

[Example 5: Binding C to Lisp]

(a)

(deffcfun (Mac_Spline "_Spline")

(integer integer integer integer integer integer integer integer) :novalue)

(b)

(defun Mac_Spline (a b c d e f g h)

(multiple-value-bind (entry a5) (ff-lookup-entry "_Spline")

(ff-call entry

:a5 a5 :long h :long g :long f :long e :long d :long c :long b :long a :novalue)))

(c)

(Mac_Spline 3 4 120 140 300 260 490 600)

Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/