% Start.jam
(user) 256 .dict .def
user .begin
(util.jam).run
(errordefs.jam).run
.end
(.start){user .begin}.cvx .def
.start

% util.jam
% last changed by Stone&Paxton, March 28, 1983 3:45 pm
% last changed by Doug Wyatt,  5-Oct-81 19:13:54

($help) .dup .where {.pop .pop} {100 .dict .def} .ifelse .cvx .exec

(/def)
{3 .copy .exch .pop .def .pop $help 3 1 .roll .put} .cvx .def

(/xdef)
{3 .copy .exch .pop .cvx .def .pop $help 3 1 .roll .put} .cvx .def

(/def)
("/def" accepts three entries on the stack: a key, string, and value.
    the string is stored under the key in the $help dictionary, and
    the value is stored as a noun under the key in the current dictionary.)
(/def).load /def

(/xdef)
("/xdef" accepts three entries on the stack: a key, string, and value.
    the string is stored under the key in the $help dictionary, and
    the value is stored as a verb under the key in the current dictionary.)
(/xdef).load /xdef

(?)
("?"    prints the explanation of the given key from the $help dictionary)
{$help .exch .get =}/xdef

(??)
("??"     prints the names of all the utility commands found in the $help 
dictionary.)
{$help /kdir}/xdef

(/print)
("/print"    prints the top of the stack)
{(                    ).cvis .print}/xdef

(/lp)
("/lp"    prints a left parenthesis)
{(())0 1 .substring .print}/xdef

(/rp)
("/rp"    prints a right parenthesis)
{(())1 1 .substring .print}/xdef

(/cr)
("/cr"    prints a carriage return)
{(
).print}/xdef

(=)
("="    prints the top of the stack and a carriage return)
{/print /cr}/xdef

(/stk)
("/stk"    prints (without destroying) the contents of the operand stack.)
{.cntstk .dup 1 .add .copy
 {.dup .type /print (    ).print =}.cvx .rept .pop}/xdef

(/pstk)
("/pstk"    pretty prints (without destroying) the contents of the operand stack.)
{.cntstk .dup 1 .add .copy
 (:tab)(:indent).lvknown {:indent}{0}/ifelse .lv {pprint} .cvx .rept .pop}/xdef

(/clr)
("/clr"    clears the operand stack  (same as .clrstk))
{.clrstk} /xdef

(/dir)
("/dir"    prints the contents of the dictionary on top of the operand stack.)
{{.exch /print (        ).print .dup .type .print
 (    ).print =}.cvx .dictforall}/xdef

(/kdir)
("/kdir" prints the keys found in the dictionary on the top of the operand
stack.)
((.exch = .pop) .cvx .dictforall)/xdef

(/if)
("/if" is equivalent to ".cvx .if")
{.cvx .if}/xdef

(/ifelse)
("/ifelse" is equivalent to ".ifelse .cvx .exec")
{.ifelse .cvx .exec}/xdef

([)
("[" is a command that marks the operand stack for use by the command "]".
This pair of commands is use to create arrays.  For example:
[ 1 2 (hello) ] 
will create an array containing two integers (1 and 2) and the string
"hello".)
{.mark}/xdef

(])
("]" is a command that counts the elements after the mark on the stack and 
puts these elements into an array which is left on the stack. 
The pair of commands ( "[" and "]" ) is use to create arrays.  For example:
[ 1 2 (hello) ] 
will create an array containing two integers (1 and 2) and the string
"hello".)
{.cnttomrk .array .astore .exch .pop}/xdef

(/run){(Running ).print .dup .print .run (.)=}.cvx .def
(/loadbcd){(Loading ).print .dup .print .loadbcd (.)=}.cvx .def

(==)
(== is used to print all types of objects in a manner which can easily be 
read. The object to be printed is expected on the operand stack.
    <x> == => -- )
{(:tab) 0 .lv pprint}/xdef

(pprint)
(pprint supports == and does all the printing)
{tabprint .dup .type .dup /print (    )/print $ptypes .exch .get .exec}/xdef

($ptypes) .dup .where {.pop .pop} {15 .dict .def} /ifelse

$ptypes .begin
(.nulltype)   {.pop /cr}.cvx .def
(.integertype){=}.cvx .def
(.realtype)   {=}.cvx .def
(.booleantype){=}.cvx .def
(.nametype)   {=}.cvx .def
(.stringtype) {/lp .print /rp /cr}.cvx .def
(.streamtype) {.pop /cr}.cvx .def
(.commandtype){.commandname =}.cvx .def
(.dicttype)   {(length )/print .dup .length /print (, maxlength )/print .maxlength =}.cvx .def
(.arraytype)  {(length )/print .dup .length = tabinc {pprint}.cvx .arrayforall tabdec}.cvx .def
(.marktype)   {.pop /cr}.cvx .def
(.exectype)   {.pop /cr}.cvx .def
(.looptype)   {.pop /cr}.cvx .def
(.scopetype)  {.scopename =}.cvx .def
.end

(tabinc){(:tab) :tab 1 .add .lvstore}.cvx .def
(tabprint){:tab {(    )/print}.cvx .rept}.cvx .def
(tabdec){(:tab) :tab 1 .sub .lvstore}.cvx .def


% JaMImager.jam
% last changed by Maureen Stone, December 9, 1983 1:54 pm

(graphics) 256 .dict .def

graphics .begin
(.setcp) {.setpos}.cvx .def
(.getcp) {.getpos} .cvx .def
(.rmoveto) {.rsetpos}.cvx .def

(twopop){.pop .pop}.cvx .def

(TwoPop) { (twopop) .load .def } .cvx .def

(.reddown) TwoPop
(RedDown) { .reddown } .cvx .def
(CtrlRedDown) TwoPop
(ShiftRedDown) TwoPop
(CtrlShiftRedDown) TwoPop

(.redup) TwoPop
(RedUp) { .redup } .cvx .def
(CtrlRedUp) TwoPop
(ShiftRedUp) TwoPop
(CtrlShiftRedUp) TwoPop

(.yellowdown) TwoPop
(YellowDown) { .yellowdown } .cvx .def
(CtrlYellowDown) TwoPop
(ShiftYellowDown) TwoPop
(CtrlShiftYellowDown) TwoPop

(.yellowup) TwoPop
(YellowUp) { .yellowup } .cvx .def
(CtrlYellowUp) TwoPop
(ShiftYellowUp) TwoPop
(CtrlShiftYellowUp) TwoPop

(.bluedown) TwoPop
(BlueDown) { .bluedown } .cvx .def
(CtrlBlueDown) TwoPop
(ShiftBlueDown) TwoPop
(CtrlShiftBlueDown) TwoPop

(.blueup) TwoPop
(BlueUp) { .blueup } .cvx .def
(CtrlBlueUp) TwoPop
(ShiftBlueUp) TwoPop
(CtrlShiftBlueUp) TwoPop

(.track) TwoPop
(Track) { .track } .cvx .def
(CtrlTrack) TwoPop
(ShiftTrack) TwoPop
(CtrlShiftTrack) TwoPop

(.interrupt){.stop}.cvx .def

(fat){.true .setfat}.cvx .def
(thin){.false .setfat}.cvx .def

(wh){white}0 .aget .def
(gr){gray}0 .aget .def
(bl){black}0 .aget .def

(m){.touch .setcp}.cvx .def
(t){.touch .translate}.cvx .def
(e){.erase}.cvx .def

(box){.touch .touch .drawbox}.cvx .def
(cbox){.touch .touch .clipbox .erase}.cvx .def
(cxbox){.touch .touch .clipxbox .erase}.cvx .def

(traj){.touch .moveto 1 .sub {.touch .lineto}.cvx .rept}.cvx .def

(area){traj .drawarea}.cvx .def
(carea){traj .cliparea .erase}.cvx .def
(cxarea){traj .clipxarea .erase}.cvx .def
(stroke){traj 2 .drawstroke}.cvx .def % round ends

(dot){2 .copy .setpos 2 .copy .drawto}.cvx .def

(spline){{.touch dot .knot}.cvx .rept .spline}.cvx .def
(cspline){{.touch dot .knot}.cvx .rept .cspline}.cvx .def

(curve){spline 2 .drawstroke}.cvx .def % round ends
(ccurve){cspline .close .drawstrokeclosed}.cvx .def

(blob){cspline .drawarea}.cvx .def
(cblob){cspline .cliparea .erase}.cvx .def

(spray){.touch .translate .pushdc
 120 {0 0 .setcp 1000 0 .drawto 3 .rotate}.cvx .rept
 .popdc}.cvx .def

(fox)(The quick brown fox jumps over the lazy dog.).def
(hi){m (Hello).drawtext}.cvx .def
(his){{.mouse .setcp (Hello).drawtext}.cvx .loop}.cvx .def
(foxes){{.mouse .setpos fox .drawtext}.cvx .loop}.cvx .def
(boxes){{.mouse .translate -25 -25 25 25 .drawbox}.cvx .loop}.cvx .def

(draw){.touch .setpos {.mouse .drawto}.cvx .loop}.cvx .def

(scribble) { (.track) { .drawto } .cvx .def (.reddown) { .setcp } .cvx .def } .cvx .def
(unscribble) { (.track) { .pop .pop } .cvx .def (.reddown) { .pop .pop } .cvx .def } .cvx .def

(grayof) (255.0 .div .grayof).cvx .def
(showr) (1 0 0 .rgbcolor .drawimage).cvx .def
(showg) (0 1 0 .rgbcolor .drawimage).cvx .def
(showb) (0 0 1 .rgbcolor .drawimage).cvx .def
%blue.ais redfile.ais greenfile.ais showimage
(showimage) (0 0 .setcp .true .setopaque showg .false .setopaque showr showb .true .setopaque).cvx .def

%display the 8 bits/pixel colormap
(map8) (.initdc (cindex) 0 .def 16 (onerow -30 16 .mul 30 .translate).cvx .rept).cvx .def
%display the 4 bits/pixel colormap
(map4) ((cindex) 0 .def onerow).cvx .def
(cindex) 0 .def
(onerow) (16 (cindex onebox 30 0 .translate cindex 1 .add (cindex) .exch .store).cvx .rept).cvx .def
(onebox) (.getmapvalue .rgbcolor 0 0 30 30 .drawbox).cvx .def

(e) (.true .setopaque .erase) .cvx .def

%define some color names
% .black, .white, .red, .green, .blue, .magenta, .cyan, .yellow, .gray all defined in TJaMColorImpl
(black){.black}.cvx .def
(white){.white}.cvx .def
(gray){.gray}.cvx .def
(red){.red}.cvx .def
(green){.green}.cvx .def
(blue){.blue}.cvx .def
(magenta){.magenta}.cvx .def
(cyan){.cyan}.cvx .def
(yellow){.yellow}.cvx .def

(darkBrown) {0.075 .5 0.3 .hsvcolor} .cvx  .def
(brown) {0.075 .5 .5 .hsvcolor} .cvx  .def
(tan) {.075 .4 .8 .hsvcolor} .cvx  .def
(darkRed) {0.0 1.0 0.4 .hsvcolor} .cvx  .def
(lightRed) {0 .5 1  .hsvcolor} .cvx  .def
(orange) {0.075 1.0 1.0 .hsvcolor} .cvx  .def
(darkYellow) {.167 1 .5 .hsvcolor} .cvx  .def
(lightYellow) {0.167 .6 1.0 .hsvcolor} .cvx  .def
(darkGreen) {0.333 1.0 0.4 .hsvcolor} .cvx  .def
(lightGreen) {0.333 0.5 1.0 .hsvcolor} .cvx  .def
(darkBlue) {0.67 1.0 0.5 .hsvcolor} .cvx  .def
(lightBlue) {0.67 0.4 1.0 .hsvcolor} .cvx  .def
(purple) {0.776 1 .8 .hsvcolor} .cvx  .def
(violet) {0.776 .5 .8 .hsvcolor} .cvx  .def
(pink) {0.833 0.4 1.0 .hsvcolor} .cvx  .def
(darkGray) {0.0 0.0 0.3 .hsvcolor} .cvx  .def
(lightGray) {0.0 0.0 0.77 .hsvcolor} .cvx  .def