' >> User program at the end, after ****** marks <<

' Library for drawing snail graphics in Microsoft QuickBasic 4.5
' Written by Jonathan H. Connell, April 2000
' For a description of functions see file: snail.txt

' ============================================================================

' Function prototypes for snail drawing package

DECLARE SUB Aim (dir$)
DECLARE SUB AimX (hlo AS SINGLE, hhi AS SINGLE)
DECLARE SUB AimN (h AS SINGLE)
DECLARE SUB Turn (num AS SINGLE, den AS SINGLE)
DECLARE SUB TurnX (nlo AS SINGLE, nhi AS SINGLE, den AS SINGLE) 
DECLARE SUB Twist ()
DECLARE SUB Untwist ()

DECLARE SUB Trail (length AS SINGLE)
DECLARE SUB BBox (x AS SINGLE, y AS SINGLE, r AS INTEGER)
DECLARE SUB TrailX (dlo AS SINGLE, dhi AS SINGLE)
DECLARE SUB TrailHome ()
DECLARE SUB Diagonal (up AS SINGLE, rt AS SINGLE)
DECLARE SUB DrawDiag (dx AS SINGLE, dy AS SINGLE)
DECLARE SUB NewAng (dx AS SINGLE, dy AS SINGLE)
DECLARE SUB Vector (dir$, length AS SINGLE)
DECLARE SUB VectorN (h AS SINGLE, length AS SINGLE)
DECLARE SUB Nest (factor AS SINGLE)
DECLARE SUB Show ()

DECLARE SUB Move (length AS SINGLE)
DECLARE SUB MoveX (dlo AS SINGLE, dhi AS SINGLE)
DECLARE SUB Shortcut (dx AS SINGLE, dy AS SINGLE)
DECLARE SUB Displace (dir$, length AS SINGLE)
DECLARE SUB DisplaceN (h AS SINGLE, length AS SINGLE)
DECLARE SUB Shortcut (rt AS SINGLE, up AS SINGLE)
DECLARE SUB Origin ()
DECLARE SUB Remember () 
DECLARE SUB Home ()
DECLARE SUB Measure ()
DECLARE SUB Center ()

DECLARE SUB Tdefs ()
DECLARE SUB Init ()
DECLARE SUB Speed (persec AS SINGLE)
DECLARE SUB Hue (cnam$)
DECLARE SUB HueX (hlo AS SINGLE, hhi AS SINGLE)
DECLARE SUB HueN (col AS SINGLE)
DECLARE SUB Size (pels AS SINGLE)
DECLARE SUB SizeX (plo AS SINGLE, phi AS SINGLE)
DECLARE SUB Grow (factor AS SINGLE)
DECLARE SUB Shrink ()


' ============================================================================

' Global drawing variables

COMMON SHARED tcd AS SINGLE,  tcx AS SINGLE,  tcy AS SINGLE
COMMON SHARED tcz AS INTEGER, tcs AS INTEGER, tcc AS INTEGER
COMMON SHARED thx AS SINGLE,  thy AS SINGLE,  thd AS SINGLE, thz AS INTEGER
COMMON SHARED tmx AS SINGLE,  tmy AS SINGLE,  tmd AS SINGLE
COMMON SHARED tmz AS INTEGER, tms AS INTEGER, tmc AS INTEGER, tmi AS INTEGER
COMMON SHARED tx0 AS SINGLE,  tx1 AS SINGLE,  ty0 AS SINGLE, ty1 AS SINGLE
COMMON SHARED tdd AS SINGLE, degrad AS SINGLE, f AS INTEGER 


' -----------------------------------------------------------------------

' Set heading to some particular value
'
SUB Aim (dir$)
  CALL Tdefs
  d$ = LCASE$(dir$)
  IF     d$ = "e"  OR dir$ = "east" OR dir$ = "right" OR dir$ = "r" THEN
    tcd = 0
  ELSEIF d$ = "ene" THEN
    tcd = 22.5
  ELSEIF d$ = "ne" OR dir$ = "northeast" THEN
    tcd = 45
  ELSEIF d$ = "nne" THEN
    tcd = 67.5
  ELSEIF d$ = "n"  OR dir$ = "north" OR dir$ = "up" OR dir$ = "u" THEN
    tcd = 90
  ELSEIF d$ = "nnw" THEN
    tcd = 115.5
  ELSEIF d$ = "nw" OR dir$ = "northwest" THEN
    tcd = 135
  ELSEIF d$ = "wnw" THEN
    tcd = 157.5
  ELSEIF d$ = "w"  OR dir$ = "west" OR dir$ = "left" OR dir$ = "l" THEN
    tcd = 180
  ELSEIF d$ = "wsw" THEN
    tcd = 202.5
  ELSEIF d$ = "sw" OR dir$ = "southwest" THEN
    tcd = 225
  ELSEIF d$ = "ssw" THEN
    tcd = 247.5
  ELSEIF d$ = "s"  OR dir$ = "south" OR dir$ = "down" OR dir$ = "d" THEN
    tcd = 270
  ELSEIF d$ = "sse" THEN
    tcd = 292.5
  ELSEIF d$ = "se" OR dir$ = "southeast" THEN
    tcd = 315
  ELSEIF d$ = "ese" THEN
    tcd = 337.5
  END IF
END SUB


' Pick a random heading base on "clock" angles
'
SUB AimX (hlo AS SINGLE, hhi AS SINGLE)
  h0 = INT(hlo)
  h1 = INT(hhi)
  IF h1 >= h0 THEN
    rng = h1 - h0
  ELSE
    rng = 12 + h1 - h0
  ENDIF
  CALL AimN(h0 + INT(RND * (rng + 1)))
END SUB


' Directly set a clock angle as an integer
'
SUB AimN (h AS SINGLE)
  CALL Tdefs
  n = INT(h) MOD 12
  IF n <= 3 THEN
    tcd = 90 - n * 30
  ELSE
    tcd = 90 + 30 * (12 - n)
  ENDIF
END SUB


' Change heading by num/den fraction of a full circle
'
SUB Turn (num AS SINGLE, den AS SINGLE)
  CALL Tdefs
  tcd = tcd + 360 * INT(num) / ABS(INT(den))
  IF tcd > 360 THEN tcd = tcd - 360
  IF tcd < 0   THEN tcd = tcd + 360
END SUB


' Turn a random amount between nlo/den and nhi/den or a circle
'
SUB TurnX (nlo AS SINGLE, nhi AS SINGLE, den AS SINGLE) 
  CALL Tdefs
  n0 = INT(nlo)
  n1 = INT(nhi)
  IF n1 >= n0 THEN
    rng = n1 - n0
  ELSE
    rng = ABS(INT(den) + n1 - n0)
  ENDIF
  CALL Turn(n0 + INT(RND * (rng + 1)), ABS(INT(den)))
END SUB


' Rotate standard coordinate frame so current snail direction is "up"
'
SUB Twist
  CALL Tdefs
  tdd = tcd - 90
  tcd = 90
END SUB


' Reestablish original orientation of coordinate system
'
SUB Untwist
  CALL Tdefs
  tcd = tcd + tdd
  tdd = 0
END SUB


' -----------------------------------------------------------------------

' Draw a color line in slow stages
'
SUB Trail (length AS SINGLE)
  CALL Tdefs

  ' compute displacement and tone change for a single step
  cnt = ABS(INT(length))
  ang = tcd + tdd
  IF length >= 0 THEN
    ang = degrad * ang
  ELSEIF ang >= 180 THEN
    ang = degrad * (ang - 180)
  ELSE
    ang = degrad * (ang + 180)
  ENDIF               
  dx = tcz * COS(ang)
  dy = tcz * SIN(ang)
  df = INT(100 * SIN(ang) + .5)     
  CALL BBox(tcx, tcy, 0)

  ' generate correct number of discrete steps of snail
  ' adjust tone, keep in 500-2K Hz range, warble if horizontal
  ' then figure out new position and draw segment
  FOR i = 0 TO cnt
    IF i < cnt THEN
      IF df > 0 AND f < 5000 THEN   
        f = f + df
      ELSEIF df < 0 AND f > 200 THEN
        f = f + df
      ELSEIF (i MOD 2) = 1 THEN     
        f = f + 50
      ELSEIF i > 0 THEN
        f = f - 50
      END IF
    END IF
    IF tcs > 0 THEN SOUND f, tcs    
    IF i > 0 THEN
      oldx = tcx
      oldy = tcy
      tcx = tcx + dx
      tcy = tcy - dy
      IF tcs >= 0 THEN LINE (oldx, oldy)-(tcx, tcy), tcc
    ENDIF
  NEXT
  CALL BBox(tcx, tcy, 0)
END SUB


' Update de-rotated bounding box to include the circle given
'
SUB BBox (x AS SINGLE, y AS SINGLE, r AS INTEGER)
  ' be careful to untwist coordinates when recording
  IF x = tmx AND y = tmy THEN
    nx = 0
    ny = 0
  ELSE
    dx = x - tmx
    dy = tmy - y
    ang = tdd * degrad
    nx =  dx * COS(ang) + dy * SIN(ang)
    ny = -dx * SIN(ang) + dy * COS(ang)
  ENDIF

  ' write initial values or stretch old box
  x0 = nx - r
  x1 = nx + r
  y0 = ny - r
  y1 = ny + r
  IF tmi = 0 THEN
    tx0 = x0    
    tx1 = x1
    ty0 = y0
    ty1 = y1
    tmi = 1
  ELSE
    IF x0 < tx0 THEN tx0 = x0
    IF x1 > tx1 THEN tx1 = x1
    IF y0 < ty0 THEN ty0 = y0
    IF y1 > ty1 THEN ty1 = y1
  ENDIF
END SUB


' Draw a random length line within specified limits
'
SUB TrailX (dlo AS SINGLE, dhi AS SINGLE)
  d0 = INT(dlo)
  d1 = INT(dhi)
  IF d1 >= d0 THEN
    CALL Trail(d0 + INT(RND * (d1 - d0 + 1)))
  ELSE
    CALL Trail(d1 + INT(RND * (d0 - d1 + 1)))
  ENDIF
END SUB


' Turn based on string specification then draw
'
SUB Vector (dir$, length AS SINGLE)
  CALL Aim(dir$)
  CALL Trail(length)
END SUB


' Turn based on integer "clock hour" specification then draw
'
SUB VectorN (h AS SINGLE, length AS SINGLE)
  CALL AimN(h)
  CALL Trail(length)
END SUB


' Draw a line to the "home" position recorded by "Remember"
'
SUB TrailHome
  CALL Tdefs
  dx = thx - tcx
  dy = tcy - thy
  IF dx <> 0 OR dy <> 0 THEN
    CALL NewAng(dx, dy)
    tcd = tcd - tdd
    CALL DrawDiag(dx, dy)
  ENDIF
  tcd = thd
END SUB


' Draw a line with given offsets in current coordinate system
'
SUB Diagonal (rt AS SINGLE, up AS SINGLE)
  CALL Tdefs
  dx = INT(rt)
  dy = INT(up)
  IF dx <> 0 OR dy <> 0 THEN
    CALL NewAng(dx, dy)
    CALL DrawDiag(dx * tcz, dy * tcz)
  ENDIF
END SUB


' Draw a diagonal line given absolute pixel offsets
'
SUB DrawDiag (dx AS SINGLE, dy AS SINGLE)
  hyp = SQR(dx * dx + dy * dy)              ' compute number of steps 
  length = INT(hyp / tcz - 0.5)
  oldz = tcz
  tcz = INT(hyp - length * tcz + 0.5)       ' special first step size
  Trail(1)
  tcz = oldz
  Trail(length)
END SUB


' Figure out new heading based on X and Y offsets
'
SUB NewAng (dx AS SINGLE, dy AS SINGLE)
  IF dx <> 0 OR dy <> 0 THEN
    IF dx > 0 THEN         
      tcd = ATN(dy / dx) / degrad
    ELSEIF dx < 0 THEN
      tcd = ATN(dy / dx) / degrad + 180
    ELSEIF dy >= 0 THEN
      tcd = 90
    ELSE
      tcd = 270
    ENDIF
    IF tcd < 0    THEN tcd = tcd + 360
    IF tcd >= 360 THEN tcd = tcd - 360
  ENDIF
END SUB


' Draw a circle with the current size and color, fill with black
'
SUB Nest (factor AS SINGLE)
  CALL Tdefs

  ' compute desired size
  IF factor >= 0 THEN
    sz% = INT(factor) * tcz / 2
  ELSE
    sz% = tcz / (2 * INT(-factor))
  ENDIF
  IF sz% <= 0 THEN sz% = 1

  ' draw circle
  IF tcs > 0 THEN SOUND 300, 2 * tcs
  CIRCLE (tcx, tcy), sz%, tcc
  PAINT (tcx, tcy), 0, tcc
  IF tcs > 0 THEN SOUND 200, 2 * tcs
  f = 1500          

  ' update drawing bounding box if necessary
  CALL BBox(tcx, tcy, sz%)
END SUB


' Draw a picture of the snail at correct position and orientation
'
SUB Show 
  CALL Tdefs
  c = 6
  z = 5

  ' figure out how coordinate system is aligned
  ang = degrad * (tcd + tdd)
  dx =  z * COS(ang)
  dy = -z * SIN(ang)
  IF dx >= 0 THEN
    pdx = dy
    pdy = -dx
  ELSE
    pdx = -dy
    pdy = dx
  ENDIF

  ' draw figure
  CIRCLE (tcx+2*dx+2*pdx, tcy+2*dy+2*pdy), 2*z, c
  CIRCLE (tcx+2*dx+2*pdx, tcy+2*dy+2*pdy), z, c
  LINE (tcx, tcy)-(tcx+4*dx, tcy+4*dy), c
  LINE (tcx+4*dx, tcy+4*dy)-(tcx+6*dx+2*pdx, tcy+6*dy+2*pdy), c
  LINE (tcx+5*dx+pdx, tcy+5*dy+pdy)-(tcx+5*dx+3*pdx, tcy+5*dy+3*pdy), c
END SUB


' -----------------------------------------------------------------------

' Quickly travel along the current heading without drawing
'
SUB Move (length AS SINGLE)
  CALL Tdefs
  ang = degrad * (tcd + tdd)

  tcx = tcx + INT(length) * tcz * COS(ang)
  tcy = tcy - INT(length) * tcz * SIN(ang)
  IF tcs > 0 THEN SOUND 600, tcs
  f = 1500          
END SUB


' Move a random number of steps between dlo and dhi
'
SUB MoveX (dlo AS SINGLE, dhi AS SINGLE)
  d0 = INT(dlo)
  d1 = INT(dhi)
  IF d1 >= d0 THEN
    CALL Move(d0 + INT(RND * (d1 - d0 + 1)))
  ELSE
    CALL Move(d1 + INT(RND * (d0 - d1 + 1)))
  ENDIF
END SUB


' Move to complet diagonal of specified displacements
'
SUB Shortcut (rt AS SINGLE, up AS SINGLE)
  dx = INT(rt) * tcz
  dy = INT(up) * tcz
  IF dx <> 0 OR dy <> 0 THEN
    CALL NewAng(dx, dy)
    ang = -tdd * degrad
    nx =  dx * COS(ang) + dy * SIN(ang)
    ny = -dx * SIN(ang) + dy * COS(ang)
    tcx = tcx + nx
    tcy = tcy - ny
    IF tcs > 0 THEN SOUND 600, tcs
    f = 1500          
  ENDIF
END SUB


' Turn based on string specification then relocate
'
SUB Displace (dir$, length AS SINGLE)
  CALL Aim(dir$)
  CALL Move(length)
END SUB


' Turn based on integer "clock hour" specification then relocate
'
SUB DisplaceN (h AS SINGLE, length AS SINGLE)
  CALL AimN(h)
  CALL Move(length)
END SUB


' Return to middle of the screen oriented updward
'
SUB Origin
  CALL Tdefs
  tcx = 320
  tcy = 240
  tcd = 90
  IF tcs > 0 THEN SOUND 500, tcs
  f = 1500
END SUB


' Save current location and orientation for future return
'
SUB Remember
  CALL Tdefs
  thx = tcx
  thy = tcy
  thd = tcd
END SUB


' Return to previously recorded position and orientation
'
SUB Home
  CALL Tdefs
  tcx = thx
  tcy = thy
  tcd = thd
  IF tcs > 0 THEN SOUND 500, tcs
  f = 1500
END SUB


' Turn off actual drawing and see what area a figure covers
'
SUB Measure 
  CALL Tdefs
  tmx = tcx        ' save current state
  tmy = tcy
  tmd = tcd
  tmz = tcz
  tms = tcs
  tmc = tcc
  tmi = 0          ' initialize bounding box
  tcs = -1         ' turn off drawing
END SUB


' Move to start position so figure is centered at the current position
'
SUB Center 
  CALL Tdefs
  tcd = tmd                              ' restore most of old state
  tcz = tmz
  tcs = tms
  tcc = tmc
  IF tmi = 0 THEN 
    tcx = tmx                            ' restore start if nothing drawn
    tcy = tmy
  ELSE
    dx = (tx1 + tx0) / 2.0               ' find bbox center in real coords
    dy = (ty1 + ty0) / 2.0
    ang = -tdd * degrad
    nx =  dx * COS(ang) + dy * SIN(ang)
    ny = -dx * SIN(ang) + dy * COS(ang)
    tcx = tmx - nx                       ' adjust starting position
    tcy = tmy + ny
  ENDIF
  IF tcs > 0 THEN SOUND 400, tcs
  f = 1500          
END SUB


' -----------------------------------------------------------------------

' Check for proper default values for snail control variables
'
SUB Tdefs
  IF tcz = 0 THEN 
    CALL Init
    degrad = 3.141593 / 180
    RANDOMIZE TIMER
    SCREEN 12
    SLEEP 2
  ENDIF
END SUB


' Set default values for all parameters
'
SUB Init
  f = 1500
  tcz = -1
  tcs = 0
  CALL Hue("red")
  CALL Origin
  CALL Size(20)
  CALL Grow(1)
  CALL Speed(9)
  CALL Untwist
  CALL Remember
  CALL Measure
  tcs = 0
  CALL Speed(9)
END SUB


' Set pause between drawing steps
'
SUB Speed (persec AS SINGLE)
  CALL Tdefs
  rate = INT(persec)
  IF tcs >= 0 THEN
    IF rate > 0 THEN 
      tcs = 18.2 / rate
      IF tcs = 0 THEN tcs = 1
    ELSEIF rate = 0 THEN 
      tcs = 0
    ENDIF
  ENDIF 
END SUB


' Set color to draw lines with
'
SUB Hue (cnam$)
  col$ = LCASE$(LTRIM$(cnam$))
  IF     col$ = "w" OR col$ = "white"  OR col$ = "0" THEN
    CALL HueN(0)
  ELSEIF col$ = "y" OR col$ = "yellow" OR col$ = "1" THEN
    CALL HueN(1)
  ELSEIF col$ = "r" OR col$ = "red"    OR col$ = "2" THEN
    CALL HueN(2)
  ELSEIF col$ = "b" OR col$ = "blue"   OR col$ = "3" THEN
    CALL HueN(3)
  ELSEIF col$ = "g" OR col$ = "green"  OR col$ = "4" THEN
    CALL HueN(4)
  ELSEIF col$ = "a" OR col$ = "aqua"   OR col$ = "5" THEN
    CALL HueN(5)
  ELSEIF col$ = "p" OR col$ = "pink"   OR col$ = "6" THEN
    CALL HueN(6)
  END IF
END SUB


' Pick a random color in given range (order is 0:wyrbgap:6)
'
SUB HueX (hlo AS SINGLE, hhi AS SINGLE)
  h0 = INT(hlo)
  h1 = INT(hhi)
  IF h0 >= 0 AND h1 >= 0 THEN
    IF h1 >= h0 THEN
      rng = h1 - h0
    ELSE
      rng = 7 + h1 - h0
    ENDIF
    CALL HueN(h0 + INT(RND * (rng + 1)))
  ENDIF
END SUB


' Utility decodes a number into a color
'
SUB HueN (col AS SINGLE)
  CALL Tdefs
  i = INT(col) MOD 7
  IF i = 0 THEN
    tcc = 15
  ELSEIF i = 1 THEN
    tcc = 14
  ELSEIF i = 2 THEN
    tcc = 12
  ELSEIF i = 3 THEN
    tcc = 9
  ELSEIF i = 4 THEN
    tcc = 10
  ELSEIF i = 5 THEN
    tcc = 11
  ELSE
    tcc = 13
  ENDIF
END SUB


' Set step size in terms of pixels
'
SUB Size (pels AS SINGLE)
  CALL Tdefs
  p = INT(pels)
  IF p > 0 THEN tcz = p
END SUB


' Pick a random size within given range
'
SUB SizeX (plo AS SINGLE, phi AS SINGLE)
  CALL Tdefs
  p0 = INT(plo)
  p1 = INT(phi)
  IF p0 > 0 AND p1 >= p0 THEN 
    tcz = p0 + INT(RND * (p1 - p0 + 1))
  ENDIF
END SUB


' Temporarily multiply size by some factor
'
SUB Grow (factor AS SINGLE)
  CALL Tdefs
  mult = INT(factor)
  thz = tcz
  IF mult > 0 THEN
    tcz = mult * tcz
  ELSEIF mult < 0 THEN
    tcz = tcz / -mult
    IF tcz <= 0 THEN tcz = 1
  ENDIF
END SUB


' Restore size from before temporary change
'
SUB Shrink
  CALL Tdefs
  tcz = thz
END SUB


' User's program follows:

' ***********************************************************************