%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 <control> # <final> ". If <init>-<inc> > <final> in the first
   ! example, or < <final> 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 <from> to <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' <from> and <to>, 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 from<first point %then from=first point
         %if to>points-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-1<first point %then { from-1=first point } from=first point+1
         %if to+1>points-1 %then { to+1=points-1 } to=points-2
         %return %if to<from
      %finish

      %if display hull = yes %start
         enable(poly plane)
         %if on or off = on %then colour(poly plane) %else colour(erase)
         %for i = from+1, 1, to+1 %cycle
            draw hull ( i )
         %repeat
      %finish

      enable(curve plane ! highlight plane)
      %if on or off = on %start
         %if highlight curve = yes %then colour(draw) %else colour(curve plane)
      %finish %else colour(erase)
      %for i = from+1, 1, to+1 %cycle
         draw curve ( i )
      %repeat
   %end

   %routine update all ( %integer on or off )
      ! Update entire picture.
      update ( first point, points-1, no, on or off )
      %if display control = yes %and open curve=no %start
         enable(poly plane ! highlight plane)
         %if on or off = on %start
            %if highlight<=i<=highlight + highlight length-1 %then %c
               colour(draw) %else colour(poly plane)
         %finish %else colour(erase)
         draw poly ( 0 ) { close poly }
      %finish
   %end





   !     -----     Point and knot processing stuff     -----

   %integerfn which point ( %integer x, y )
      ! Returns a point close to cursor. Returns <no point> 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
                                                                                                                                                                                                    