%begin ! NB A lot of the for loops in this program are of the form ! ! %if x <= y %start ! %for i = x, 1, y %cycle ! : ! %repeat ! %finish ! ! or of the form ! ! %if x >= y %start ! %for i = x, -1, y %cycle ! : ! %repeat ! %finish ! ! This is because of IMP's wonderful habit of treating a 'for' loop as ! " while # ". If - > in the first ! example, or < in the second, then the loop never terminates. ! ! Aaaaaarrrrghhhhh !!! ! ! ----- Miscellaneous -------- %option "-low" %option "-nons" %include "level1:graphinc.imp" %integer i, n %halfarray cm ( 0:255 ) %constinteger yes=1, no=0 %constinteger on=yes, off=no ! ----- Graphics constants ----- %constinteger erase=0, draw=255 %constinteger point plane = 1, poly plane = 2, curve plane = 4, cursor plane = 8, text plane = 16, highlight plane = 64, background plane = 128 %constinteger screenaddr = 16_e00000 %integerfn mix colour ( %half red, green, blue ) %result = red + green<<5 + blue<<10 %end ! ----- ... and screen layout ----- %constinteger SCREENWIDTH = 1024 %constinteger SCREENMULT = SCREENWIDTH // 8 %constinteger VISSCREENHEIGHT = 512 %constinteger VISSCREENWIDTH = 688 ! Position of areas of screen %constinteger cmd menu x boundary = 580 %constinteger knot x boundary = 50 %constinteger mouse y boundary = 480 ! Whether to restrict cursor movement ( should be mutually exclusive ) %integer keep in screen = no, keep in knots = no, keep in menu = yes %integer display hull = no { whether to draw convex hull } %integer display control = yes { ditto control points and poly } ! ----- Commands ----- %constinteger n commands = 11 %ownstring(10)%array menu(1:n commands*3) = %c "Change", "point", "", { Description of each } "Add", "point", "", { command can have up } "Remove", "point", "", { to three lines } "Make", "multiple", "knot", "Show", "convex", "hull", "Hide", "control", "polygon", "Initialise", "open", "curve", "Initialise", "closed", "curve", "Initialise", "Jeremy", "", "Output", "", "", "Quit", "", "" %ownintegerarray words ( 1:n commands ) = 2, 2, 2, 3, 3, 3, 3, 3, 2, 1, 1 { no of lines for each command } %ownintegerarray cum n words(1:n commands) = 0, 3, 6, 9, 13, 17, 21, 25, 29, 32, 34 ! cum n words(i) is sum of 1+words(j) for j = [1,i-1] ! 1+words(j) to allow room for line separating commands in menu %constinteger n words = 36 { total no. of lines in menu } %constinteger cmd height = mouse y boundary//n words { ... and height of each } %constinteger menu y = ( 512 - n words*cmd height ) // 2 { to centre menu } %routine display menu ! Clear menu area, and display menu %integer i, j, l, x %string(15) text enable(text plane!highlight plane) colour(erase) fill(cmd menu x boundary, 1, 680, 510 ) { clear area } colour(text plane) vline(cmd menu x boundary, menu y, menu y+n words*cmd height) vline(680, menu y, menu y+n words*cmd height) x=n words*cmd height hline(cmd menu x boundary,680,menu y + x) %for i = 1, 1, n commands %cycle %for j = 1, 1, words(i) %cycle text = menu((i-1)*3+j) l = string width(text) textat(cmd menu x boundary+(680-cmd menu x boundary-l)//2, menu y + x-cmd height-4) showstring(text) x = x - cmd height %repeat x = x - cmd height hline(cmd menu x boundary,680,menu y + x) %repeat %end ! For each command that needs further input, there is an array giving ! the meaning of each mouse button. This gets displayed at the top of the ! screen. %ownstring(9)%array menu info ( 1:3 ) = %c "Pick"(*) %ownstring(9) %array change info ( 1:3 ) = %c "Pick", "", "Abort" %ownstring(9) %array add info ( 1:3 ) = %c "Highlight", "Pick", "Abort" %ownstring(9) %array remove info ( 1:3 ) = %c "Pick", "", "Abort" ! %ownstring(9) %array multiple info ( 1:3 ) = %c ! "Pick", "", "Abort" same as remove info ! None needed for hull, initialise, quit %string(9)%arrayname mouse info { points to current one } %routine display mouse info ! Clear mouse info area, and display current info %integer i, l %ownstring(3) %array buttonstring (1:3) = "L: ", "M: ", "R: " enable(text plane!highlight plane) colour(erase) fill(knot x boundary + 6, mouse y boundary+1, cmd menu x boundary-8, visscreenheight-2 ) ! right-justify info for right button l = stringwidth(buttonstring(3)) + stringwidth(mouse info(3)) textat(cmd menu x boundary-8 - l, mouse y boundary+5) colour(text plane) showstring(buttonstring(3)) colour(text plane!highlight plane) showstring(mouse info(3)) ! left justify info for left button textat(knot x boundary+6, mouse y boundary+5) colour(text plane) showstring(buttonstring(1)) colour(text plane!highlight plane) showstring(mouse info(1)) ! ... and centre info for middle button l = ( (cmd menu x boundary-8 - (knot x boundary+6)) - { available space } %c ( l + { length of right info } %c (text x pos-(knot x boundary+6)) + { ... of left } %c stringwidth(buttonstring(2)) + stringwidth(mouse info(2)) ) %c )//2 { and of middle } textat ( text x pos + l, text y pos ) colour(text plane) showstring(buttonstring(2)) colour(text plane!highlight plane) showstring(mouse info(2)) %end %ownstring(63) message = "" %routine display message ! Print out message at bottom of screen. Gets removed at next button press enable(text plane!highlight plane) colour(erase) fill ( knot x boundary+6, 1, cmd menu x boundary-8, 31 ) colour(draw) text at ( ( cmd menu x boundary-8 - (knot x boundary+6) - %c stringwidth(message) ) // 2 + knot x boundary+6, 6 ) show string(message) %end ! ----- Cursor stuff ----- %constinteger hand=0, arrow = 1 { cursor types } %owninteger cursor at x = visscreenwidth // 2, cursor at y = visscreenheight // 2, { where cursor is on screen } cursor drawn x=0, cursor drawn y=0 { where cursor last drawn }, cursor type=hand, buttons, old buttons, cursor command=0 { cmd cursor points to }, command, old command=0, knot no { which knot cursor points to }, old knot no=-1 %owninteger knot y, knot d, knot n ! Vertical displacement, interval size and no. of intervals of knot display %ownintegerarray hand rast ( 0:29 ) = %c 16_0fff0000, 16_0fff0000, 16_0fff0000, 16_0fff0000, 16_0fff0000, 16_0fff0000, 16_04020000, 16_04020000, 16_04010000, 16_08010000, 16_08010000, 16_10010000, 16_10008000, 16_20008000, 16_21448000, 16_49248000, 16_89248000, 16_99248000, 16_69248000, 16_09270000, 16_09240000, 16_09e40000, 16_09180000, 16_09000000, 16_09000000, 16_09000000, 16_0F000000, 16_09000000, 16_09000000, 16_06000000 ! Bottom to top, left to right, MSB at left %ownintegerarray arrow rast ( 0:13 ) = %c 16_1f000000, 16_11000000, 16_11000000, 16_11000000, 16_11000000, 16_11000000, 16_11000000, 16_11000000, 16_f1e00000, 16_40400000, 16_20800000, 16_11000000, 16_0a000000, 16_04000000 %ownintegerarray hand details ( 0:4 ) = %c -5, -30, 1, 30, 0 { x bias, y bias, width in words, height, address } %ownintegerarray arrow details ( 0:4 ) = %c -5, -14, 1, 14, 0 %integerarrayname details { points to current details } ! Following is gross routine nicked from my CS4 project ... deals with ! wrapround in framestore, for arbitrary positioning of cursor and offset %routine place rast ( %integer x, y, ww, h, p ) ! place raster on screen, with bottom left corner at (x,y) ! raster is h rows of ww words, starting at p, and stored ! left column, ... right column, each stored bottom row, ..., top row %label cont, xloop2 %integer frame p, shift frame p = screenaddr + (y&1023)*screenmult + (x&1023)>>3&(\1) shift = x&15 *move.l d4, a1 { need to use d4 } *move.l #0, a0 *move.l p, a2 { pointer to pattern to display } *move.l frame p, a3 { left of bottom line to display } *move.l shift, d3 *move.l ww, d4 { no. of words } yloop: *move.l a3, d2 { frame pointer } *move.l h, d1 { no of rows to do } *move.l d2, d0 { if x-wrapround ... } *and.l #16_7f, d0 *cmp.l #16_7e, d0 *beq xloop2 { ... need different routine } xloop1: *move.l (a2)+, d0 { fetch word of pattern } *lsr.l d3, d0 { shift right } *move.l d0, 0(a0,d2) { and store } *add.l #screenmult, d2 { next row } *bclr #17, d2 { deal with any y-wrapround } *subq.l #1, d1 { and repeat } *bne xloop1 *bra cont xloop2: { if we have an x-wrapround ... } *move.w (a2), d0 { left-hand half of pattern } *lsr.w d3, d0 { shift and ... } *move.w d0, 0(a0,d2) { ... store } *move.l (a2)+, d0 { get whole lot for right hand half } *lsr.l d3, d0 { shift and ... } *move.w d0, -126(a0,d2) { ... store lower half } *add.l #screenmult, d2 { next row } *bclr #17, d2 { deal with y-wrap } *subq.l #1, d1 { repeat } *bne xloop2 cont: *add.l #2, a3 { next column } *subq.l #1, d4 { and repeat } *bne yloop *move.l a1, d4 { restore d4 } %end %routine read cursor ! Set cursor at x, cursor at y. Clip to within desired region of screen. ! Sets knot no if cursor pointing to a knot, cursor command if pointing ! to a command. Sets cursor type to hand if in menu, to arrow otherwise. ! Sets buttons to mouse buttons. %integer x, i %routine pause { crude mouse debounce } %integer i %for i = 1, 1, 50 %cycle; %repeat %end cursor at x = cursor at x + rel mouse x cursor at y = cursor at y + rel mouse y buttons = mouse buttons pause %if keep in knots = yes %start %if cursor at x < 6 %then cursor at x = 6 %if cursor at x > knot x boundary + 6 %then %c cursor at x = knot x boundary + 6 %finish %else %if keep in screen = yes %start %if cursor at x < knot x boundary + 6 %then %c cursor at x = knot x boundary + 6 %if cursor at x > cmd menu x boundary-8 %then cursor at x = %c cmd menu x boundary-8 %if cursor at y < 33 %then cursor at y = 33 %if cursor at y > mouse y boundary-1 %then cursor at y = mouse y boundary-1 %finish %else %if keep in menu = yes %start %if cursor at x < cmd menu x boundary %then cursor at x = cmd menu x boundary %if cursor at x > 680 %then cursor at x = 680 %if cursor at y < menu y %then cursor at y = menu y %if cursor at y > menu y + n words*cmd height %then cursor at y = %c menu y + n words*cmd height %finish %else %start %if cursor at x < 6 %then cursor at x = 6 %if cursor at x > visscreenwidth-15 %then cursor at x = visscreenwidth-15 %if cursor at y < 33 %then cursor at y = 33 %if cursor at y > mouse y boundary-1 %then cursor at y = mouse y boundary-1 %finish %if cursor at x >= cmd menu x boundary %start x = ((menu y+cmd height*n words)-cursor at y)//cmd height { no of words down } cursor command = 0 %for i = n commands, -1, 1 %cycle %if x >= cum n words(i) %start cursor command=i %exit %finish %repeat cursor command=0 %unless 1<=cursor command<=n commands %finish %else cursor command = 0 %if cursor at x < knot x boundary %start %if cursor at y >= knot y - knot d//2 %start knot no = ( cursor at y + knot d//2 - knot y ) // knot d knot no = -1 %if %not 0 <= knot no <= knot n %finish %else knot no = -1 %finish %else knot no = -1 %if cursor at x >= cmd menu x boundary %then cursor type = hand %c %else cursor type = arrow %end %routine display cursor ( %integer change menu ) %routine highlight command ( %integer cmd ) %integer i, x %if cmd#0 %start i = n words - cum n words(cmd) x = i*cmd height fill(cmd menu x boundary, menu y + x-(1+words(cmd))*cmd height, 680, menu y + x) %finish %end %routine highlight knot ( %integer n ) %if n>=0 %start fill(1, knot y + n*knot d - (knot d >> 2), knot x boundary, knot y + n*knot d + (knot d>>2) ) %finish %end read cursor %if change menu = yes %and cursor command#old command %start ! Highlight menu item enable(highlight plane) colour(erase) highlight command(old command) colour(255) highlight command(cursor command) old command = cursor command %finish %if old knot no # knot no %start ! Highlight knot enable(highlight plane) colour(erase) highlight knot(old knot no) colour(255) highlight knot(knot no) old knot no = knot no %finish %if cursor at x # cursor drawn x %or cursor at y # cursor drawn y %start ! If cursor has moved, redraw it enable(cursor plane) { protect other planes } colour(erase) place rast ( cursor drawn x + details(0), cursor drawn y + details(1), details(2), details(3), details(4) ) { erase old cursor } cursor drawn x = cursor at x cursor drawn y = cursor at y %if cursor type = hand %then details==hand details %c %else details==arrow details colour(draw) place rast ( cursor drawn x + details(0), cursor drawn y + details(1), details(2), details(3), details(4) ) { ... and draw new one } %finish %end %integerfn await button press ( %integer change menu ) display cursor ( change menu ) %until buttons#0 message = "" { clear any error message } display message %result = buttons %end %routine await button release ( %integer old buttons, change menu ) display cursor ( change menu ) %until buttons & old buttons = 0 %end ! ----- Curve drawing stuff ----- %recordformat point f ( %integer x, y %or %integerarray p(0:1) ) %constinteger max points = 100 %record(point f)%array point ( -2:max points-1) %constinteger no point = -3 { null point number for functions to return etc } %integer points=-2, highlight=no point, highlight length=0, { highlighting on control polygon } first point, last knot { for some independence of whether curve is open } %record(point f) q0, q1, q2 { global points set when drawing curve } %integer open curve { whether curve is open or closed } %integerarray knot ( -2:max points + 2 ) %constintegerarray t2 ( 1:16 ) = %c 1, 4, 9, 16, 25, 36, 49, 64, 81, 100, 121, 144, 169, 196, 225, 256 ! table of squares %routine draw interval ! q0, q1 and q2 are set by relevant "draw M" routine to ! M . ( point(k-2), point(k-1), point(k) )' ! ie relevant M matrix, multiplied by column matrix of points ! Values calculated by all-integer arithmetic ( shift up by 8, calc, shift ! down by 8 ). Calculated for 16 intervals between knots. %integer t, x, y, x1, y1 x = q0_x; y = q0_y %for t = 1, 1, 16 %cycle x1 = ( ( ( q0_x<<4 + t*q1_x ) << 4 ) + t2(t)*q2_x ) >> 8 y1 = ( ( ( q0_y<<4 + t*q1_y ) << 4 ) + t2(t)*q2_y ) >> 8 line ( x, y, x1, y1 ) x = x1; y = y1 %repeat %end %routine draw M ( %integer k ) ! Normal interval, ie with no multiple knots on either side %integer i %for i = 0, 1, 1 %cycle q0_p(i) = ( point(k-2)_p(i) + point(k-1)_p(i) ) // 2 q1_p(i) = point(k-1)_p(i) - point(k-2)_p(i) q2_p(i) = ( point(k-2)_p(i) + point(k)_p(i) ) // 2 - point(k-1)_p(i) %repeat draw interval %end %routine draw M plus 03 ( %integer k ) ! Interval with multiple knot on left only. %integer i %for i = 0, 1, 1 %cycle q0_p(i) = point(k-2)_p(i) q1_p(i) = ( point(k-1)_p(i) - point(k-2)_p(i) ) * 2 q2_p(i) = point(k-2)_p(i) + ( point(k)_p(i) - 3*point(k-1)_p(i) ) // 2 %repeat draw interval %end %routine draw M minus 03 ( %integer k ) ! Interval with multiple knot on right only %integer i %for i = 0, 1, 1 %cycle q0_p(i) = ( point(k-2)_p(i) + point(k-1)_p(i) ) // 2 q1_p(i) = point(k-1)_p(i) - point(k-2)_p(i) q2_p(i) = point(k)_p(i) + ( point(k-2)_p(i) - 3*point(k-1)_p(i) ) // 2 %repeat draw interval %end %routine draw M plus minus 03 ( %integer k ) ! Interval with multiple knots to left and right ! ( 1 0 0 ) ! M = ( -2 2 0 ) ! ( 1 -2 1 ) %integer i %for i = 0, 1, 1 %cycle q0_p(i) = point(k-2)_p(i) q1_p(i) = 2*( point(k-1)_p(i) - point(k-2)_p(i) ) q2_p(i) = point(k-2)_p(i) - 2*point(k-1)_p(i) + point(k)_p(i) %repeat draw interval %end ! ----- Knot routines ----- %predicate multiple knot(%integer i) %if open curve = no %and i >= last knot %then i = i-points { wrap } %true %if ( i>-2 %and knot(i-1) = knot(i) ) %or %c ( i < last knot %and knot(i) = knot(i+1) ) ! Note "i>-2", not "i>first point" cos must check for wrapround in closed curve %false %end %routine display knots %integer x, i %ownstring(5) text="Knots" enable(text plane ! highlight plane) colour(erase) fill(1,1,knot x boundary, 510) { clear area } knot n = knot(last knot)-knot(first point) { number of intervals } knot d = 20 { try interval size of 20 } %if 460//knot n < knot d %then knot d = 460//knot n { squash if necessary } knot y = 10+(460-knot d*knot n)//2 { and centre it } colour(text plane!highlight plane) textat(6, knot y+knot d*(knot n+1) ) showstring(text) { heading } colour(text plane) vline(30, knot y, knot y+knot n*knot d) %for i = 0, 1, knot n %cycle text at(6, knot y+i*knot d-5) show i(i, 0) hline(28,32,knot y+i*knot d) %repeat { draw scale } x = 35 { ... and place each knot } fill ( x, knot y {+knot d*knot(first point)} -1, x+2, knot y{+knot d*knot(first point)}+1 ) %for i = first point + 1, 1, last knot %cycle %if knot(i)=knot(i-1) %then x = x+5 %else x=35 fill ( x, knot y+knot d*knot(i)-1, x+2, knot y+knot d*knot(i)+1 ) %repeat %end ! ----- Drawing 'primitives' ----- %routine draw point ( %integer i ) %if i>points-1 %then i = i-points ! Can't happen for open curve, cos i<=points-1 fill ( point(i)_x-2, point(i)_y-2, point(i)_x+2, point(i)_y+2 ) %end %routine draw poly ( %integer i ) ! Draw section of control poly, from point(i-1) to point(i) %if i>points-1 %then i = i-points ! Can't happen for open curve, cos i<=points-1 line ( point(i-1)_x, point(i-1)_y, point(i)_x, point(i)_y ) %end %routine draw hull ( %integer i ) ! Draw section of convex hull, a triangle: point(i-2), point(i-1) and point(i) %if i>points-1 %then i = i-points ! Can't happen for open curve, cos i<=points-1 triangle(point(i-2)_x,point(i-2)_y, point(i-1)_x,point(i-1)_y, point(i)_x,point(i)_y) %end %routine draw curve ( %integer i ) ! Draw section of curve, between knot(i) and knot(i+1), using points ! i-2 to i. %integer j %if i>points-1 %then i = i-points ! Can't happen for open curve, cos i<=points-1 %if open curve = no %and i=last knot %then j=i-points %else j=i ! so can check knot(i+1) %if knot(j) # knot(j+1) %start %if multiple knot(i) %and multiple knot(i+1) %then %c draw M plus minus 03 ( i ) %else %c %if multiple knot(i) %then draw M plus 03 ( i ) %else %c %if multiple knot(i+1) %then draw M minus 03 ( i ) %else %c draw M ( i ) %finish %end %routine update ( %integer from, to, highlight curve, on or off ) ! Update picture. Do: ! points from to ! control poly between these points ! all sections of convex hull and curve that use at least two ! of these points ! If curve open, 'clip' and , else wrap round ! If highlight curve=yes, section of curve drawn is highlighted. ! Global variables highlight, highlight length control highlighting of ! control polygon. %integer i %if open curve = no %start %if from=-2 %start from = from+points to = to+points %finish %finish ! If curve is closed, from-1 >= -2 %if open curve=yes %start %if frompoints-1 %then to=points-1 %finish %return %if to<=from %if on or off = on %then colour(draw) %else colour(erase) %if display control = yes %start enable(point plane) %for i = from, 1, to %cycle draw point ( i ) %repeat enable(poly plane ! highlight plane) %for i = from+1, 1, to %cycle %if on or off = on %start %if highlight<=i-1<=highlight + highlight length-1 %then %c colour(draw) %else colour(poly plane) %finish draw poly ( i ) %repeat %finish %if open curve = yes %start %if from-1points-1 %then { to+1=points-1 } to=points-2 %return %if to if none found. ! Starts searching from first point. %integer i %for i = first point, 1, points-1 %cycle %if point(i)_x-9 <= x <= point(i)_x+9 %and %c point(i)_y-9 <= y <= point(i)_y+9 %then %result=i %repeat %result=no point %end %routine wrap round ! Copy last 2 points and knots to positions -2, -1. Makes calculating ! things easier if we don't have to worry about wrapround. ! Only called if curve is closed. knot(-1) = knot(0)-1 knot(-2) = knot(-1) - ( knot(last knot)-knot(last knot-1) ) ! difference between knot(-2) and knot(-1) same as between ! knot(last knot-1) and knot(last knot) point(-2) = point(points-2) point(-1) = point(points-1) %end %routine remove point ( %integer n ) ! Remove point n, and knot n+1. Wierd? Yes, but gives natural results - ! if there is a kink at point n, removing point n will remove the kink. ! Frig if curve is open, to ensure we don't remove first or last 3 knots. %integer i ! Removing an end point ( first or last three ) of open curve can have ! far-reaching effect, since we remove the knot that's 4th from the end. ! Hence, I can't be bothered working out exactly which intervals may ! change, I just update them all ... update all ( no ) %if n <= points-2 %start { shuffle points up } %for i = n, 1, points-2 %cycle point ( i ) = point ( i+1 ) %repeat %finish ! Now "remove" knot n+1 %if open curve = no %start %if n+1 > last knot %then n = n-points { wrapround } %finish %if open curve = yes %start ! Musn't "remove" first or last 3 knots, or curve won't terminate properly %if n+1>=points %then n=points-2 { n+1 = points-1 } %if n+1<=0 %then n=0 { n+1 = 1 } %finish %if multiple knot(n+1) %start { knots just shuffle down, but don't change } %if n+1 <= last knot-1 %start %for i = n+1, 1, last knot-1 %cycle knot(i) = knot(i+1) %repeat %finish %finish %else %start { shuffle, and reduce number of intervals } %if n+1 <= last knot-1 %start %for i = n+1, 1, last knot-1 %cycle knot(i) = knot(i+1)-1 %repeat %finish %finish points = points - 1 last knot = last knot - 1 %if open curve=no %then wrap round update all ( yes ) display knots %end %routine add point ( %integer n, x, y ) ! Add point n = (x,y), and shuffle knots up. New knot will be single, ! even if added in middle of multiple knot - just add it at the end ! instead. %integer i, j update ( n-1, n, no, off ) j=n; j=j+1 %while j<=last knot %and knot(j) = knot(n) { if n in multiple knot, j after end of knot } %if last knot >= j-1 %start %for i = last knot, -1, j-1 %cycle knot(i+1) = knot(i)+1 %repeat %finish %if points-1 >= n %start %for i = points-1, -1, n %cycle point(i+1) = point(i) %repeat %finish point(n)_x = x; point(n)_y = y points = points+1 last knot = last knot + 1 %if open curve=no %then wrap round update ( n-1, n+1, no, on ) display knots %end %routine change point ( %integer n, x, y ) ! Change value of point n update ( n-1, n+1, no, off ) point(n)_x=x point(n)_y=y %if open curve=no %then wrap round ! redundant update of knot(-2),(-1) but never mind update ( n-1, n+1, yes, on ) %end %routine make multiple knot ( %integer n ) ! Make knot n multiple, and add new point n-1 as midpoint of ! point(n-2), point(n-1) ! ( weird choice of new point for reasons explained in "remove point" above ) ! Assumes knot not already multiple %integer i %record(point f) p update ( n-2, n-1, no, off ) ! Make knot(n) multiple %if last knot >= n %start %for i = last knot, -1, n %cycle knot(i+1) = knot(i) %repeat %finish ! Now make point(n-1) = midpoint of point(n-2),point(n-1) and shuffle pts up %for i = 0, 1, 1 %cycle p_p(i) = (point(n-2)_p(i)+point(n-1)_p(i))//2 %repeat %if points-1 >= n-1 %start %for i = points-1, -1, n-1 %cycle point(i+1) = point(i) %repeat %finish point(n-1) = p points = points+1 last knot = last knot + 1 %if open curve=no %start ! If we added a point before point 0 ( ie n-1<0 ), then wrapround will ! change it. So we must copy it to the other end of the curve first. %if n-1<0 %start point(points-1) = point(-1) point(points-2) = point(-2) %finish wrap round %finish update ( n-2, n, no, on ) display knots %end %routine initialise open curve ! Points from -2 to points-1 ! Knots from -2 to points+2 open curve=yes first point = -2 point(-2)_x = 200; point(-2)_y = 356 point(-1)_x = 200; point(-1)_y = 156 point(0)_x = 400; point(0)_y = 156 point(1)_x = 400; point(1)_y = 356 points=2 knot(-2)=0; knot(-1)=0; knot(0)=0 knot(1)=1 knot(2)=2; knot(3)=2; knot(4)=2 last knot = points+2 update all ( yes ) display knots %end %routine initialise closed curve ! Points from 0 to points-1; point(-2)=point(points-2), point(-1)=point(points-1) ! Knots from 0 to points-1; knot(-2)=knot(points-2), knot(-1)=knot(points-1) open curve=no first point = 0 point(0)_x = 200; point(0)_y = 356 point(1)_x = 200; point(1)_y = 156 point(2)_x = 400; point(2)_y = 156 point(3)_x = 400; point(3)_y = 356 points=4 knot(0)=0 knot(1)=1 knot(2)=2 knot(3)=3 last knot = points-1 wrap round update all ( yes ) display knots %end %routine initialise jeremy ! Points from -2 to points-1 ! Knots from -2 to points+2 open curve=yes first point = -2 point(-2)_x = 194; point( -2)_y = 326 point(-1)_x = 157; point( -1)_y = 189 point(0)_x = 124; point( 0)_y = 114 point(1)_x = 82; point( 1)_y = 161 point(2)_x = 193; point( 2)_y = 216 point(3)_x = 238; point( 3)_y = 256 point(4)_x = 206; point( 4)_y = 257 point(5)_x = 181; point( 5)_y = 202 point(6)_x = 230; point( 6)_y = 203 point(7)_x = 267; point( 7)_y = 249 point(8)_x = 256; point( 8)_y = 260 point(9)_x = 242; point( 9)_y = 247 point(10)_x = 264; point( 10)_y = 229 point(11)_x = 292; point( 11)_y = 251 point(12)_x = 261; point( 12)_y = 199 point(13)_x = 280; point( 13)_y = 205 point(14)_x = 315; point( 14)_y = 229 point(15)_x = 336; point( 15)_y = 250 point(16)_x = 309; point( 16)_y = 249 point(17)_x = 280; point( 17)_y = 199 point(18)_x = 337; point( 18)_y = 200 point(19)_x = 376; point( 19)_y = 251 point(20)_x = 376; point( 20)_y = 252 point(21)_x = 358; point( 21)_y = 200 point(22)_x = 371; point( 22)_y = 240 point(23)_x = 391; point( 23)_y = 254 point(24)_x = 411; point( 24)_y = 251 point(25)_x = 393; point( 25)_y = 197 point(26)_x = 407; point( 26)_y = 241 point(27)_x = 451; point( 27)_y = 261 point(28)_x = 420; point( 28)_y = 166 point(29)_x = 475; point( 29)_y = 254 point(30)_x = 454; point( 30)_y = 202 point(31)_x = 483; point( 31)_y = 197 point(32)_x = 513; point( 32)_y = 253 point(33)_x = 455; point( 33)_y = 102 point(34)_x = 403; point( 34)_y = 120 point(35)_x = 498; point( 35)_y = 189 point(36)_x = 564; point( 36)_y = 175 points=37 knot(-2) = 0 knot(-1) = 0 knot(0) = 0 knot(1) = 1 knot(2) = 2 knot(3) = 3 knot(4) = 4 knot(5) = 5 knot(6) = 6 knot(7) = 7 knot(8) = 8 knot(9) = 9 knot(10) = 10 knot(11) = 11 knot(12) = 12 knot(13) = 12 knot(14) = 13 knot(15) = 14 knot(16) = 15 knot(17) = 16 knot(18) = 17 knot(19) = 18 knot(20) = 19 knot(21) = 19 knot(22) = 20 knot(23) = 20 knot(24) = 21 knot(25) = 22 knot(26) = 23 knot(27) = 23 knot(28) = 24 knot(29) = 25 knot(30) = 26 knot(31) = 26 knot(32) = 27 knot(33) = 28 knot(34) = 28 knot(35) = 29 knot(36) = 30 knot(37) = 31 knot(38) = 31 knot(39) = 31 last knot = points+2 update all ( yes ) display knots %end ! ----- Start up ----- %integer point x, point y, first highlight hand details(4) = addr(hand rast) arrow details(4) = addr(arrow rast) details == hand details offset ( 0, 0 ) ! Set up colours. %for i = 0, 1, 255 %cycle cm(i) = 0 %if i&background plane#0 %start %if i&highlight plane#0 %then cm(i) = mix colour(21, 21, 21) {light grey} %c %else cm(i) = mix colour( 10, 10, 10 ) %finish %if i&point plane#0 %start cm(i) = mix colour ( 0, 31, 0 ) { green } %finish %if i&text plane#0 %start %if i&highlight plane#0 %then cm(i) = mix colour ( 31, 0, 0 ) { red } %c %else cm(i) = mix colour ( 31, 0, 31 ) { magenta } %finish %if i&poly plane#0 %start %if i&highlight plane#0 %then cm(i) = mix colour ( 7, 31, 31 ) { cyan } %c %else cm(i) = mix colour ( 0, 15, 31 ) { blue-ish } %finish %if i&curve plane#0 %start %if i&highlight plane#0 %then cm(i) = mix colour ( 31, 23, 0 ) { orange } %c %else cm(i) = mix colour ( 31, 0, 0 ) { red } %finish %if i&cursor plane#0 %then cm(i) = mix colour ( 31, 31, 0 ) { yellow } %repeat update colour map ( cm(0) ) ! Draw screen enable(255) colour(background plane) fill(0,0,687,511) colour(erase) fill(knot x boundary+6,33,cmd menu x boundary-8, mouse y boundary-1) colour(background plane!highlight plane) hline(knot x boundary+5,cmd menu x boundary-7,32) hline(knot x boundary+5,cmd menu x boundary-7,mouse y boundary) vline(knot x boundary+5, 32, mouse y boundary) vline(cmd menu x boundary-7, 32, mouse y boundary) hline(0,687,0) hline(0,687,511) vline(0,0,511) vline(687,0,511) mouse info == menu info display mouse info display menu initialise open curve ! ----- Main loop ----- %cycle old buttons = await button press ( yes ) %if cursor command#0 %start command = cursor command await button release ( old buttons, no ) keep in menu = no keep in screen = yes %if command=1 %start { change point } mouse info == change info display mouse info { update information } %cycle old buttons = await button press ( no ) %if old buttons=mouse left %start { pick point to change } point x = cursor at x point y = cursor at y i = which point ( point x, point y ) { find point } %if i>no point %start change point ( i, point x, point y ) %cycle display cursor ( no ) point x = cursor at x point y = cursor at y %if point x # point(i)_x %or point y#point(i)_y %then %c change point(i, point x, point y) %repeat %until buttons&old buttons = 0 ! Move point til button released update all ( yes ) { in case we've wiped something } %finish %else %start { not near any point } await button release ( old buttons, no ) %finish %finish %else %if old buttons=mouse right %then %exit %repeat await button release ( old buttons, no ) %finish %else %c %c %if command=2 %start { add point } %if open curve=yes %then first highlight=first point %else%c first highlight=first point-1 ! Where to start highlight cycle mouse info == add info display mouse info highlight length=1 highlight = first highlight update ( highlight, highlight+1, no, on ) { draw highlight } %cycle %if points=max points %start message = "Max no of points reached" display message %exit %finish old buttons = await button press ( no ) %if old buttons=mouse left %start { cycle highlighting } highlight = highlight + 1 update ( highlight-1, highlight, no, on ) { remove old highlight } %if highlight=points-1 %then highlight=first highlight update ( highlight, highlight+1, no, on ) { ... and draw new } await button release ( old buttons, no ) %finish %else %if old buttons = mouse middle %start ! add point in middle of highlighted section highlight length = 2 add point(highlight+1, cursor at x, cursor at y) %cycle { now move into desired position } display cursor(no) point x = cursor at x point y = cursor at y %if point x # point(highlight+1)_x %or %c point y#point(highlight+1)_y %then %c change point(highlight+1, point x, point y) %repeat %until buttons & old buttons = 0 highlight length = 1 update all ( yes ) { in case we've wiped something } %finish %else %if old buttons = mouse right %then %exit %repeat await button release ( old buttons, no ) highlight length = 0 update ( highlight, highlight+1, no, on ) { remove highlight } %finish %else %c %c %if command = 3 %start { remove points } mouse info == remove info display mouse info %cycle %if (open curve=yes %and points = 1) %or %c (open curve=no %and points=3) %start message = "At minimum number of points" display message %exit %finish old buttons = await button press ( no ) point x = cursor at x point y = cursor at y %if old buttons=mouse left %start { remove selected point } i = which point ( point x, point y ) %if i>no point %then remove point ( i ) await button release ( old buttons, no ) %finish %else %if old buttons=mouse right %then %exit %repeat await button release ( old buttons, no ) %finish %else %c %c %if command=4 %start { add multiple knot } mouse info == remove info display mouse info keep in screen = no keep in knots = yes %cycle old buttons = await button press ( no ) %if old buttons=mouse left %start %if knot no >= 0 %start n = no point { find which knot was selected } %for i = first point, 1, last knot %cycle %if knot(i) = knot no %start n = i %exit %finish %repeat %if n > no point %start %if multiple knot(n) %start message = "Already multiple knot" display message %finish %else %start make multiple knot(n) %finish %finish %finish await button release ( old buttons, no ) %finish %else %if old buttons=mouse right %then %exit %repeat await button release ( old buttons, no ) %finish %else %c %c %if command = 5 %start { display/remove convex hull } update all ( no ) %if display hull = yes %start display hull = no menu(13) = "Show" { change menu item } %finish %else %start display hull = yes menu(13) = "Hide" %finish display menu update all ( yes ) await button release ( old buttons, no ) %finish %else %c %c %if command = 6 %start { display/remove control poly } update all ( no ) %if display control = yes %start display control = no menu(16) = "Show" { change menu item } %finish %else %start display control = yes menu(16) = "Hide" %finish display menu update all ( yes ) await button release ( old buttons, no ) %finish %else %c %c %if 7 <= command <= 9 %start { initialise curve } update all ( no ) { remove old picture } %if command = 7 %then initialise open curve %else %c %if command = 8 %then initialise closed curve %else %c initialise jeremy await button release ( old buttons, no ) %finish %else %c %c %if command = 10 %start open output(1, "jeremy") select output(1) printstring("Points:");newline %for i = -2, 1, points-1 %cycle printstring("point(");write(i,5);printstring(")_x = "); write(point(i)_x,3); printstring("; point(");write(i,5);printstring(")_y = "); write(point(i)_y,1);newline %repeat printstring("Knots:");newline %for i = -2, 1, last knot %cycle printstring("knot(");write(i,5);printstring(") = "); write(knot(i),3);newline %repeat close output select output(0) await button release ( old buttons, no ) %finish %else %c %c %if command = 11 %start { quit } await button release ( old buttons, no ) %exit %finish keep in knots = no { restore cursor restrictions } keep in screen = no keep in menu = yes mouse info == menu info { ... and main mouse info } display mouse info %finish %repeat %endofprogram